plxmm[求助]求代码:如何把vfp中的.dbf数据格式保存为.xls格式

fclyjzyk

QUOTE:

以下是引用qee用在2006-6-13 16:49:07的发言：

还有,你的机器上装没装VFP.
看看数据源驱动里有没有Microsoft  FoxPro VFP Driver(*.dbf)

我刚下载了一个vfp6.0，不用安装就能使用的那种，不知道可不可以。

请问在哪里能看到数据源驱动呢？

fclyjzyk

可以运行了，只是运行后提示文件不存在，真是冤枉，怎么会不存在呢？

我的文件名是“*200505.dbf”，*代表2到3个文字

提示如下：

        

QUOTE:

运行时错误'-2147217865(80040e37)';

         [Microsoft][ODBC Visual FoxPro Driver] File 'xx.dbf' does not exist.

[此贴子已经被作者于2006-6-22 12:42:57编辑过]

fclyjzyk

谁知道代码中的"select * from xx"是什么意思？   xx是什么？

刚才查看了一下帮助文件，应当属于Source参数吧，帮助文件太难懂了，不知道为什么要写成"select * from xx"

[此贴子已经被作者于2006-6-22 12:37:07编辑过]

plxmm

把 "select * from xx" 中的 xx 改为你的数据库中的表名称。

fclyjzyk

plxmm：太感谢你了，真不知说什么感谢的话好。如果将来有缘分的话，我一定请你吃饭……

fclyjzyk

能不能把源代码再完善一下，实现批量读取.dbf文件并另存为相同文件名的.xls文件呢？

plxmm

偶的机子没法运行与ADO相关的程序。建议参看帮助中的：

FileSearch 对象，做相关的循环处理来实现。

fclyjzyk

由于本人功力有限，找不到合适的代码，还望高人指教。

试写代码如下（错误），请有心人改正：

'*****************************************************************

Sub a()
Dim nm As String
Set fs = Application.FileSearch
With fs
    .LookIn = "D:\ls"
    .FileType = msoFileTypeAllFiles
    If .Execute > 0 Then
        MsgBox "There were " & .FoundFiles.Count & _
            " file(s) found."
        For j = 1 To .FoundFiles.Count
       
        nm = .FoundFiles(j)
            
        Call b(nm)
       
        ActiveWorkbook.SaveAs Filename:=nm, FileFormat:=xlExcel7
       
        ActiveWorkbook.Close
                
        Next j
    Else
        MsgBox "There were no files found."
    End If
End With

End Sub

'*******************************************************************

Sub b(ByVal s As String)  '估计此处错误
Dim i%
Dim cnn As New ADODB.Connection, rst As New ADODB.Recordset
cnn.Open "Driver={Microsoft Visual FoxPro Driver};SourceType=DBF;SourceDB=d:\ls;"
rst.Open "select * from s", cnn, adOpenStatic, adLockReadOnly      '想用变量s表示文件名
Cells.Clear
For i = 0 To rst.Fields.Count - 1
Cells(1, i + 1) = rst.Fields(i).Name
Next i
Cells(2, 1).CopyFromRecordset rst
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub

[此贴子已经被作者于2006-6-22 16:30:29编辑过]

fclyjzyk

dddddddddddd

爱歌学习

U9TCh9lc.rar (24.32 KB, 下载次数: 104)

2006-6-22 23:19 上传

点击文件名下载附件
plxmm[求助]求代码:如何把vfp中的.dbf数据格式保存为.xls格式

Sub DBF_NEWXLS()
    Dim oConndbf, oConnxls, oResult, strSQL$, sName$
    Set oConndbf = CreateObject("ADODB.Connection")
    Set oConnxls = CreateObject("ADODB.Connection")
   
    '打开选取文件对话框，将选取的各文件全路径名存于 Filename 数组中
    Filename = Application.GetOpenFilename("dbase Files (*.dbf), " & _
                    "*.dbf", , "请选取文件", , MultiSelect:=True)
    If Not IsArray(Filename) Then Exit Sub      '如果未选取文件，则退出程序
   
    On Error Resume Next   '关闭错误开关，以跳过“已有相同文件夹存在”的错误提示
    MkDir ThisWorkbook.Path & "\Excel文件"
    On Error GoTo 0        '打开错误开关
    For Each fn In Filename
        sName = Dir(fn)
        oConndbf.Open "Driver={Microsoft Visual FoxPro Driver};" & _
                        "SourceType=DBF;SourceDB=" & Left(fn, Len(fn) - Len(sName) - 1)
        strSQL = "Select * from " & sName
        Set oResult = oConndbf.Execute(strSQL)
        Cells.Clear
        For col = 1 To oResult.fields.Count     '以上结果不包含字段名，故需循环产生
           Cells(1, col) = oResult.fields(col - 1).Name
        Next
        [a2].CopyFromRecordset oResult
       
        '产生新文件
        oConnxls.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;" & _
                        "Data Source=" & ThisWorkbook.FullName
        strSQL = "SELECT * INTO [Sheet1] IN '" & ThisWorkbook.Path & "\Excel文件\" & _
                    Left(sName, Len(sName) - 4) & ".xls' 'Excel 8.0;' FROM [临时表$]"
        Set oResult = oConnxls.Execute(strSQL)
        oConndbf.Close: oConnxls.Close
    Next
    Set oConndbf = Nothing: Set oConnxls = Nothing
    MsgBox "文件已产生在“Excel文件”文件夹下"
End Sub