将工作表名称输出到ACCESS VBA中的表中

问题描述

我有以下代码来获取所选工作簿的所有工作表名称。如何获取工作表的所有名称并将其导入到Access数据库中的表中？

Public Sub PickSheets1(fileName As String)

    Dim objExc As Object
    Dim objWbk As Object
    Dim objWsh As Object
       
    sqlInsert = "INSERT INTO Sheets Table (Sheets) Values (objWbk.Worksheets.Name)"
    Set TabInsert = CurrentDb.CreateTableDef("Sheets Table")
    Set TabFields = TabInsert.CreateField("Sheets")
    
    Set objExc = CreateObject("Excel.Application")
    Set objWbk = objExc.Workbooks.Open(fileName)
    Set objWsh = objWbk.Worksheets.Name
    
    DoCmd.Runsql sqlInsert
    
    'For Each objWsh In objWbk.Worksheets
        'TabFields("Sheets").Value objWsh.Name
        
    Set objWsh = nothing
    objWbk.Close
    Set objWbk = nothing
    objExc.Quit
    Set objExc = nothing
    
End Sub

解决方法

因此，您可以在MSAccess中运行此代码。它使用DAO将工作表名称添加到表中。假定具有“ SheetName”列的表“ Sheets Table”已经存在。

致电loadSheetNames（“ C：Path \ Workbook.xlsx”）

Function loadSheetNames(pstrWB As String)
    
    ' Access
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    
    ' Excel
    Dim xl As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlWS As Excel.Worksheet
    
    Set db = CurrentDb
    Set rst = db.OpenRecordset("Sheets Table")
    
    Set xl = CreateObject("Excel.Application")
    Set xlWB = xl.Workbooks.Open(pstrWB)
    
    For Each xlWS In xlWB.Sheets
        Debug.Print xlWS.NAME
        rst.AddNew
        rst("SheetName") = xlWS.NAME
        rst.update
    Next
        
    Set rst = Nothing
    Set db = Nothing
    
    Set xlWS = Nothing
    Set xlWB = Nothing
    Set xl = Nothing
    
End Function

如果您想在Excel中运行代码，我也可以提供。