将单个工作表中的多个动态Excel数据区域导入MS Access

Question

嗨，我需要一些帮助来编写VBA代码以自动将多个Excel（csv格式）文件导入Access。我需要导入的每个文件中的一个工作表上有2个数据范围。两个数据范围都有动态行数。Excel文件，让我们称它们为“SourceDataXXX. csv”，所有数据都在同一个工作表上，让我们称它为“InputData”。第一组数据总是从单元格A4开始，是7列数据（在单元格G4结束）。这组数据有可变数量的数据行。在第二组数据之前总是有一行空白，然后有一行文本要忽略。这组数据有19列宽，行数可变。这2组数据将放入2个不同的表中。所有excel文件（约70-80个文件）的第一组数据将在一个表中，第二组的所有数据将在第二个表中。从网站上的其他问题中，我可以看到如何执行单个动态范围，但我不确定如何跳转到第二组数据。

Sub ImportDataFromRange()
'Access variables
Dim dbFile As Database
Dim tbl As TableDef, fld As Field

'Excel variables
Dim xlApp As Excel.Application
Dim xlFile As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlRange As Excel.Range
Dim r#, c#
Dim clVal As String 'string to hold cell's value, may need to modify this type.

Set dbFile = CurrentDb

'Use this to create a new table definition
'    Set tbl = dbFile.CreateTableDef("Test")
'Use this if your table already exists:
    Set tbl = dbFile.TableDefs("Test")

'Get the info from Excel:
Set xlApp = New Excel.Application

Set xlFile = xlApp.Workbooks.Open("C:\Users\david_zemens\desktop\Book1.xlsx")
Set xlSheet = xlFile.Sheets("Sheet1")
Set xlRange = xlSheet.Range("A1:B10")

    For r = 1 To xlRange.Rows.Count
        For c = 1 To xlRange.Columns.Count

            'Add code to append new fields/records/etc to your table

        Next c
    Next r

在本例中，我可以使用Do-While循环在行之间循环，并在遇到Null时停止（请注意，数据集中从不存在Null数据行，甚至不存在与此相关的单元格）。一旦我找到空值，我可以在当前行号上加2，然后再次开始第二个For/Next循环。另请注意，我正在导入此数据，而不是将其链接，以允许我组合各种单独的Excel表。提前感谢您的支持

Answer 1

假设结构如下

考虑使用以下SQL格式直接从工作簿中查询，该格式符合可以查询Excel文件的MS Access：

SELECT * 
FROM [Excel 12.0 Xml;HDR=Yes;Database=C:\Path\To\Workbook.xlsx].[SheetName$A1:Z100]

挑战是找到这两个数据集的最后一行，您可以通过有条件地使用CTRL-SHIFT-END方法找到最后一行，然后将这些最后一行号传递到追加查询中。下面假设在运行之前已经创建了表，Excel电子表格的列与表完全相同。如果没有，请在插入到和选择子句中指定列。

函数（使用Excel对象的后期绑定检索两个数据集范围的最后一行）

Public Function GetLastRows() As Variant
    Dim xlApp As Object, xlFile As Object
    Const xlUp = -4162
    Dim i As Long, data1_lastrow As Long, data2_lastrow As Long

    Set xlApp = CreateObject("Excel.Application")
    Set xlFile = xlApp.workbooks.Open("C:\Path\To\Workbook.xlsx")

    With xlFile.Worksheets("ACC")
        data2_lastrow = .Cells(.Rows.Count, 7).End(xlUp).Row  ' LAST ROW OF COLUMN G

        For i = 4 To data2_lastrow
            If .Cells(i, 7) = "" Then                         ' FIRST BLANK IN COLUMN G
                data1_lastrow = i                             
                GoTo ExitFor
            End If
        Next i
    End With

ExitFor:
    xlFile.Close False
    xlApp.Quit    
    Set xlFile = Nothing: Set xlApp = Nothing

    GetLastRows = Array(data1_lastrow, data2_lastrow)
End Function

子例程（生成和运行动态动作查询）

Public Sub BuildAndRunQueries()
On Error GoTo ErrHandle
    Dim var As Variant
    Dim strSQL As String
    Dim qdef As QueryDef

    var = GetLastRows()

    'DATASET 1 QUERY W/ DYNAMIC RANGES
    strSQL = "INSERT INTO mytable1 " _
              & " SELECT * FROM [Excel 12.0 Xml;HDR=Yes;Database=C:\Path\To\Workbook.xlsx].[SheetName$A4:G" & var(0) - 1 & "] AS t;"
    CurrentDb.Execute strSQL, dbFailOnError

    ' DATASET 2 QUERY W/ DYNAMIC RANGES
    strSQL = "INSERT INTO mytable2 " _
              & " SELECT * FROM [Excel 12.0 Xml;HDR=Yes;Database=C:\Path\To\Workbook.xlsx].[SheetName$A" & var(0) + 2 & ":R" & var(1) & "] AS t;"
    CurrentDb.Execute strSQL, dbFailOnError

    MsgBox "Successfully ran queries!", vbInformation

ExitHandle:
    Set qdef = Nothing
    Exit Sub

ErrHandle:
    MsgBox Err.Number & "- " & Err.Description, vbCritical
    Resume ExitHandle
End Sub