按工作表 ADODB 的顺序从关闭的工作簿导入

Question

对我来说，ADODB 是我渴望学习的新事物。这是我尽力而为但需要您的想法以使其看起来更专业和更高效的代码。代码中的问题是数据是以相反的顺序从工作表中获取的，而不是按工作表的顺序。为了清楚起见，我有Sample.xlsx 工作簿与两张表Sheet1 和New 并且代码应该循环通过这些表然后搜索特定标题然后从这样的列中获取数据。所有这一切都与 ADO 方法有关。代码首先从新工作表中获取数据，然后从 Sheet1 中获取数据。虽然工作表的顺序是 Sheet1，然后是 New >> 另一点，但如何正确关闭记录集。我的意思是使用 .Close 就足够了，否则我必须将其设置为 Nothing Set rs=Nothing。

    Sub ImportFromClosedWorkbook()
    Dim e, ws As Worksheet, cn As ADODB.Connection, rs As ADODB.Recordset, rsHeaders As ADODB.Recordset, b As Boolean, sFile As String, shName As String, strSQL As String, iCol As Long
    sFile = ThisWorkbook.Path & "\Sample.xlsx"
    'shName = "Sheet1"
    Dim rsData As ADODB.Recordset
    Set cn = New ADODB.Connection
    cn.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & sFile & "';" & "Extended Properties=""Excel 12.0;HDR=YES;IMEX=1;"";"
    '--------
    Set ws = ThisWorkbook.ActiveSheet
    Set rs = cn.OpenSchema(20)
    Do While Not rs.EOF
        sName = rs.Fields("Table_Name")
        If Right(sName, 14) <> "FilterDatabase" Then
            sName = Left(sName, Len(sName) - 1)
            'Debug.Print sName
            b = False
            strSQL = "SELECT * FROM [" & sName & "$]"
            Set rsHeaders = New ADODB.Recordset
            rsHeaders.Open Source:=strSQL, ActiveConnection:=cn, Options:=1
            For iCol = 0 To rsHeaders.Fields.Count - 1
                'Debug.Print rsHeaders.Fields(iCol).Name
                For Each e In Array("Ref No", "Reference", "Number")
                    If e = rsHeaders.Fields(iCol).Name Then
                        b = True: Exit For
                    End If
                Next e
                If b Then Exit For
            Next iCol
        
            If b Then
                'Debug.Print e
            strSQL = "SELECT [" & e & "] FROM [" & sName & "$]"
            Set rsData = New ADODB.Recordset
            Set rsData = cn.Execute(strSQL)
            ws.Range("A" & ws.Cells(Rows.Count, 1).End(xlUp).Row + 1).CopyFromRecordset rsData
               rsData.Close
                'here I am stuck of how to get the data from the found column
            End If
        
            'rs.Close
        End If
        rs.MoveNext
    Loop
    'rs.Close

    '------------------
    '    strSQL = "SELECT * FROM [" & shName & "$]"
    '    Set rs = New ADODB.Recordset
    '    Set rs = cn.Execute(strSQL)
    '    Range("A1").CopyFromRecordset rs
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
End Sub

Answer 1

代码首先从新工作表中获取数据，然后从 Sheet1 中获取数据。虽然工作表的顺序是 Sheet1 然后是 New

Tab 键顺序是 Excel 的一项功能。使用 ADODB 时，工作表名称按字母顺序提取。这就是为什么你先得到New sheet，然后得到Sheet1。

注意：如果工作表名称以数字开头或有空格，则优先考虑它们。几个例子

示例 1

工作表名称：1、Sheet1、1Sheet4、She et3、Sheet5

返回为

'1$'
'1Sheet4$'
'She et3$'
Sheet1$
Sheet5$

示例 2

工作表名称：Sheet2、Sheet5、She et3、Sheet1、Sheet4

返回为

'She et3$'
Sheet1$
Sheet2$
Sheet4$
Sheet5$

示例 3

工作表名称：1、Sheet1、2、Sheet2、3、Sheet3

返回为

'1$'
'2$'
'3$'
Sheet1$
Sheet2$
Sheet3$

ADODB 的替代品

如果您想按 Tab 键顺序提取工作表的名称，则可以使用 DAO，如 Andrew Poulsom 在THIS 链接中所示。在这里发布代码以防链接失效...

Sub GetSecondSheetName()
'   Requires a reference to Microsoft DAO x.x Object Library
'   Adjust to suit
    Const FName As String = "P:\Temp\MrExcel\Temp\SheetNames.xls"
    Dim WB As DAO.Database
    Dim strSheetName As String
    Set WB = OpenDatabase(FName, False, True, "Excel 8.0;")
'   TableDefs is zero based
    strSheetName = WB.TableDefs(1).Name
    MsgBox strSheetName
    WB.Close
End Sub

关闭就足够了，否则我必须将其设置为 Nothing Set rs=Nothing。

不，您不必必须将其设置为空。 VBA 在退出程序时会自动清理它。但是是的，冲马桶是个好习惯。

有趣的阅读：

您可能想阅读以下链接中@GSerg 的帖子...

When should an Excel VBA variable be killed or set to Nothing?

要使其与XLSX 一起使用，请使用它（需要引用 Microsoft Office XX.XX Access 数据库引擎对象库）

Option Explicit

'~~> Change this to the relevant file name
Const FName As String = "C:\Users\routs\Desktop\Delete Me later\TEXT.XLSX"

Sub Sample()
    'Requires a reference to Microsoft Office XX.XX Access database engine Object Library
    
    Dim db As DAO.Database
    Set db = OpenDatabase(FName, False, False, "Excel 12.0")
    
    Dim i As Long
    For i = 0 To db.TableDefs.Count - 1
        Debug.Print db.TableDefs(i).Name
    Next i
    
    db.Close
End Sub

行动中

Answer 2

@Siddharth Rout 你启发了我如何为我搜索这样的新主题，我可以使用这样的代码使用 DAO 按标签顺序列出所有工作表，但具有后期绑定（我很想知道如何尝试使用早期绑定但没有成功）

Sub Get_Worksheets_Using_DAO()
    Dim con As Object, db As Object, sName As String, i As Long
    Set con = CreateObject("DAO.DBEngine.120")
    sName = ThisWorkbook.Path & "\Sample.xlsx"
    Set db = con.OpenDatabase(sName, False, True, "Excel 12.0 XMl;")
    For i = 0 To db.TableDefs.Count - 1
        Debug.Print db.TableDefs(i).Name
    Next i
    db.Close: Set db = Nothing: Set con = Nothing
End Sub