使用 VBA 获取 Excel 选项卡名称并复制到 Access 表

Posted 2023-05-07

【中文标题】使用 VBA 获取 Excel 选项卡名称并复制到 Access 表

【英文标题】：Using VBA to get Excel tab names and copy to an Access table

【发布时间】：2014-12-20 17:50:43

【问题描述】：

我需要将 Excel 文件中的选项卡名称保存到 Access 表中以供以后使用。我可以使用 Debug.Print 将它们打印到即时窗口，或者使用 Print # 将它们发送到 .txt 文件，但无法弄清楚如何将它们发送到数据库中的表中。提前感谢您的帮助。

【问题讨论】：

我不完全确定您要做什么。从它的读取方式来看，您似乎只想将每个工作表的名称以表的形式导出以访问？如，也许使用“选项卡”（即工作表）的名称创建一个新表。然后将其导入 ACCESS？

【参考方案1】：

您的问题已在 (Using Excel VBA to export data to MS Access table) 中得到部分回答。为了将数据（与您的情况相关，存储的 Excel 选项卡名称，例如，在“A”列中）从 Excel 传输到 Access 表，请使用以下代码 sn-p：

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

希望这会有所帮助。

【参考方案2】：

我不确定这是否是您所说的。我正在写这篇文章，假设您正在尝试创建一个包含工作簿中“选项卡”名称的表。然后你可以把这个新表导入到 ACCESS 中。如果我有误解，请发表评论。

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