Using VBA to get Excel tab names and copy to an Access table

Question

I need to save the names of tabs in Excel files to an Access table for later use. I'm able to print them to the Immediate window using Debug.Print, or send to a .txt file using Print #, but can't figure out how to get them to a table within the database. Thanks in advance for any help.

I am not entirely sure what you are trying to do. From the way it reads, it looks like you just want the NAME of EVERY WORKSHEET to be exported in the form of a TABLE to ACCESS? As in, perhaps create a NEW table using the names of the "tabs" (ie, worksheets). Then IMPORT it into ACCESS? — peege, Dec 22 '14 at 21:47

score 0 · Answer 1 · edited May 23 '17 at 11:57

You question is partially answered in (Using Excel VBA to export data to MS Access table). In order to transfer data (pertinent to your case, Excel tab names stored, for e.g., in a column "A") from Excel to Access Table, use the following code snippet:

Sub AccImport()
    Dim acc As New Access.Application
    acc.OpenCurrentDatabase "C:\Users\Public\Database1.accdb"
    acc.DoCmd.TransferSpreadsheet _
            TransferType:=acImport, _
            SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
            TableName:="yourExcelTable", _
            Filename:=Application.ActiveWorkbook.FullName, _
            HasFieldNames:=True, _
            ' your data column, for example A1
            Range:="Sheets1$A1:A10"
    acc.CloseCurrentDatabase
    acc.Quit
    Set acc = Nothing
End Sub

Hope this will help.

score 0 · Answer 2 · answered Dec 22 '14 at 22:58

I'm not sure if this is what you are talking about. I am writing this assuming you are trying to create a table that has the NAMES of the "tabs" from your workbook. Then you can take this new table and IMPORT it into ACCESS. If I'm misunderstanding, just comment.

Private Sub CreateSheetFromNames()

Dim ws As Worksheet
Dim lRow As Long
Dim sheet As String

'---SET UP WORKSHEET TO STORE ALL THE TAB NAMES---'
    sheet = "Master"
    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
    ws.Name = sheet

    'Format the Column Header and Font Properties
    ws.Cells(1, 1) = "Tab Name"
    With ws.Cells(1, 1).Font
        .Bold = True
    End With

    'Define Row for new sheet and loop through worksheets getting names
    lRow = 2

    For Each ws In Worksheets
        If ws.Name <> sheet Then
            Sheets(sheet).Cells(lRow, 1) = ws.Name
            lRow = lRow + 1
        End If
    Next ws

    'Widen the target column to account for widest entry
    With Sheets(sheet)
        Columns(1).AutoFit
        Columns(1).HorizontalAlignment = xlCenter
    End With

End Sub

RESULT

Using VBA to get Excel tab names and copy to an Access table

2 Answers2