Question

您好我需要一些帮助编写VBA代码以自动将多个Excel（csv格式）文件导入Access。我需要导入的每个文件中的一个工作表上有两个数据范围。两个数据范围都具有动态行计数。我们称之为“SourceDataXXX.csv”的Excel文件都在同一张纸上有数据，我们称之为“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格式，该格式符合MS Access，可以查询Excel文件：

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

挑战在于找到两个数据集的最后一行，你可以通过 CTRL + SHIFT + END 方法有条件地进行将这些最后一行编号传递给追加查询。下面假设在运行之前已经创建了表，并且Excel电子表格与表具有完全相同的列。如果没有，请在INSERT INTO和SELECT子句中指定列。

功能 （使用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

将多个动态Excel数据范围从单个工作表导入MS Access

1 个答案: