如何用ADO来实现合并多个工作簿中所有工作表的内容（工作表名称任意，非仅Sheet1表）

zhangyu05

下面的代码是网上找的关于用ado来合并多个工作簿的程序。


现在，我有这么两个问题：

1. Sql = "Select * FROM [Sheet1$] "
——要进行合并的工作簿中的工作表的名称只能是“Sheet1”，不能是任意名称，或者是Index为1（或其他）的工作簿；

2. 如果我想要合并的是多个工作簿中的所有工作表的内容（不止是“Sheet1”，而且每个工作表的名称是任意的），那么用ado实现这个功能，这个Sql语句该怎么写，如何用ado来获得一个工作簿内的所有工作表的名称



先谢谢大家了！我觉得这样一个合并功能还是非常使用的。

=======================================================

Sub Hebing()
    Dim i As Long, F() As String, l As Long
    With Application.FileSearch
        .NewSearch
        .FileType = msoFileTypeExcelWorkbooks
        .Filename = "*.XLS"
        .LookIn = ThisWorkbook.Path & "\"
        .Execute
        If .FoundFiles.Count > 0 Then
            ReDim F(1 To .FoundFiles.Count - 1) As String
            l = 1
            For i = 1 To .FoundFiles.Count
            If .FoundFiles(i) <> ThisWorkbook.FullName Then
                F(l) = .FoundFiles(i)
                l = l + 1
            End If
            Next
        End If
    End With
    Sheet1.Cells.Clear
    For i = 1 To UBound(F)
        Dim cn As ADODB.Connection
        Dim Sql As String
        Set cn = New ADODB.Connection
        With cn
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .C & F(i) & ";Extended Properties=""Excel 8.0;HDR=No"""
            .CursorLocation = adUseClient
            .Open
        End With
        Sql = "Select * FROM [Sheet1$] "
        Dim Rg As Range
        Set Rg = Sheet1.Range("A65536").End(xlUp)
        If Rg.Address = Sheet1.Range("A1").Address Then
            Rg.CopyFromRecordset cn.Execute(Sql)
        Else
            Rg.Offset(1, 0).CopyFromRecordset cn.Execute(Sql)
        End If
        cn.Close
    Next
End Sub

zhangyu05

呵呵，自己解决了。

zhangyu05

用ADO直接解决的，效率高、占用资源少。

dopod_o2

我也出现同样问题,请问如何解决,谢谢

lgpoo

感谢楼主的分享

学习了

lzhuohui

.C & F(i) & ";Extended Properties=""Excel 8.0;HDR=No"""----语法错误？？？？？

lizhim09

同问。代码识别错误，若六楼所示。该怎么解决