Вывод имен рабочих листов в таблицу в ACCESS VBA

#vba #ms-access

#vba #ms-доступ #ms-access

Вопрос:

У меня есть приведенный ниже код, чтобы получить все названия листов выбранной книги. Как мне получить все названия листов и импортировать их в таблицу в базе данных 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
  

Ответ №1:

Итак, из MSAccess вы можете запустить этот код. Он использует DAO для добавления имени листа в таблицу. Предполагается, что таблица ‘Sheets Table’ со столбцом ‘SheetName’ уже существует.

вызовите loadSheetNames(«C:PathWorkbook.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, я могу предоставить вам и это.