Question

我有以下代码，可以让我选择一个特定的电子表格并将其导入到我的表格中。我遇到的问题是总共有4个选项卡（所有列标题都相同，只是不同类型的数据）。

是否可以使用此导入功能，将每个选项卡中的数据（总共4个选项卡）导入到我的表中，只需一次导入？

模块：

Function selectFile()
    Dim fd As FileDialog, fileName As String

On Error GoTo ErrorHandler

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    fd.AllowMultiSelect = False

    If fd.Show = True Then
        If fd.SelectedItems(1) <> vbNullString Then
            fileName = fd.SelectedItems(1)
        End If
    Else
        'Exit code if no file is selected
        End
    End If

    'Return Selected FileName
    selectFile = fileName

    Set fd = Nothing

Exit Function

ErrorHandler:
    Set fd = Nothing
    MsgBox "Error " & Err & ": " & Error(Err)

End Function

形式：

Private Sub cmdImport_Click()
    'Unset warnings
    DoCmd.SetWarnings False

    'Import spreadsheet
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "Table123", selectFile, True

    DoCmd.SetWarnings True
End Sub

添加了以下范围（由于4个标签/工作表而增加了4次）：

   Private Sub cmdImport_Click()

Dim selectFile() As String

    'Unset warnings
    DoCmd.SetWarnings False

    'Import spreadsheet
    DoCmd.TransferSpreadsheet TransferType:=acImport, _
                          SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
                          TableName:="Producer Pro Inquiries", _
                          fileName:=selectFile, _
                          HasFieldNames:=True, _
                          Range:="Medicare$"

      DoCmd.TransferSpreadsheet TransferType:=acImport, _
                          SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
                          TableName:="Producer Pro Inquiries", _
                          fileName:=selectFile, _
                          HasFieldNames:=True, _
                          Range:="Centene Medicare$"

         DoCmd.TransferSpreadsheet TransferType:=acImport, _
                          SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
                          TableName:="Producer Pro Inquiries", _
                          fileName:=selectFile, _
                          HasFieldNames:=True, _
                          Range:="Medsupp$"

           DoCmd.TransferSpreadsheet TransferType:=acImport, _
                          SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
                          TableName:="Producer Pro Inquiries", _
                          fileName:=selectFile, _
                          HasFieldNames:=True, _
                          Range:="Commercial$"

    DoCmd.SetWarnings True

End Sub

尝试导入时，当我选择文件时，文件对话框会重新打开，要求我再次选择文件（继续这样做）。

Answer 1

TransferSpreadsheet方法提供了另一个字段来设置导入的Range。您需要为方法提供范围（工作表名称）。

DoCmd.TransferSpreadsheet TransferType:=acImport, _
                          SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
                          TableName:="Table123", _
                          FileName:=selectFile, _
                          HasFieldNames:=True, _
                          Range:="Sheet1$"

注意：如果FileDialog的Show不是0，则会进行选择 - 无需检查vbNullString.

If fd.Show <> 0 Then selectFile = fd.SelectedItems(1)

编辑：

在你的情况下，它会是这样的：

Private Sub cmdImport_Click()

    Dim filepath As String
        filepath = selectFile()

    If Len(filepath) = 0 Then Exit Sub

    With DoCmd
        .SetWarnings False
        .TransferSpreadsheet TransferType:=acImport, _
                          SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
                          TableName:="Table123", _
                          FileName:=filepath, _
                          HasFieldNames:=True, _
                          Range:="ZZ$"
        .TransferSpreadsheet TransferType:=acImport, _
                          SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
                          TableName:="Table123", _
                          FileName:=filepath, _
                          HasFieldNames:=True, _
                          Range:="YY$"
         .TransferSpreadsheet TransferType:=acImport, _
                          SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
                          TableName:="Table123", _
                          FileName:=filepath, _
                          HasFieldNames:=True, _
                          Range:="XX$"
        .TransferSpreadsheet TransferType:=acImport, _
                          SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
                          TableName:="filepath", _
                          FileName:=selectFile, _
                          HasFieldNames:=True, _
                          Range:="WW$"
        .SetWarnings True
    End With
End Sub

Answer 2

通过使用SQL查询Excel工作表和联合查询，您可以一次导入多个Excel工作表，甚至多个文件。

当然，您可以使用动态SQL修改文件位置和工作表名称

SELECT *
INTO MyTable
FROM (
    SELECT * 
    FROM [Sheet1$A:C] 
    IN 'C:\MyFile.xlsx'[Excel 12.0 XML;HDR=Yes;]
    UNION ALL
    SELECT *
    FROM [Sheet2$A:C]
    IN 'C:\MyFile.xlsx'[Excel 12.0 XML;HDR=Yes;]
    UNION ALL
    SELECT *
    FROM [Sheet3$A:C]
    IN 'C:\MyFile.xlsx'[Excel 12.0 XML;HDR=Yes;]
) u

或者，使用动态SQL时：

Dim fileLocation As String
fileLocation = selectFile
Dim Range1 As String
Range1 = "ZZ$"
'Other ranges here
Dim strSQL As String
strSQL = "SELECT * INTO MyTable FROM (" & _ 
" SELECT * FROM [" & Range1 & "] " & _ 
" IN '" & fileLocation & "'[Excel 12.0 XML;HDR=Yes;]" & _ 
" UNION ALL" & _ 
" SELECT * FROM [" & Range2 & "] " & _ 
" IN '" & fileLocation & "'[Excel 12.0 XML;HDR=Yes;]" & _ 
" UNION ALL" & _ 
" SELECT * FROM [" & Range2 & "] " & _ 
" IN '" & fileLocation & "'[Excel 12.0 XML;HDR=Yes;]" & _ 
" ) u"
CurrentDb.Execute strSQL

访问文件对话框导入 - 导入多个Excel选项卡/工作表

2 个答案:

编辑：