Importing multiple dynamic Excel Data ranges from a single sheet into MS Access

Question

Hi I need some help writing VBA code to automate the importing of multiple Excel (csv format) files into Access. There are 2 ranges of data on one sheet in each file that I need to import. Both ranges of data have dynamic row counts. The Excel files , lets call them “SourceDataXXX.csv”all have the data on the same sheet, lets call it “InputData”. The first set of data always starts at cell A4 and is 7 columns of data (ending at cell G4). This set of data has a variable number of rows of data. There is always a blank row then a row of text to be ignored before the second set of data. This set of data is 19 columns wide and has a variable number of rows. The 2 sets of data will be put into 2 different tables. All data from the first set for all excel files (approx. 70-80 files) will be in one table and all data from the second set will be in a second table. From other questions on the site I can see how to do a single dynamic range, but I’m not sure how to jump to the second set of data.

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

In this example could I use a Do While loop to cycle through the rows and stop when I hit a Null (Note there are never Null rows of data, or even cells for that matter, in the dataset). Once I hit the Null I could add 2 to the current row number and begin again with a second For/Next loop. Also note I am importing this data and not linking it to allow me to combine the various individual Excel sheets. Thanks in advance for any support

FWIW, you can create a linked table to an Excel s/s. That can be incredibly useful sometimes. — smoore4
You can also you DoCmd.TransferSpreadsheet. it has a range property that can used. you can also loop through our sheets as well. — Doug Coats

Parfait Parfait · Accepted Answer · 2018-03-23T18:52:14

Assuming a structure as below

Consider directly querying from workbook with below SQL format which is compliant in MS Access that can query Excel files:

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

The challenge is to find the last row of both datasets which you can do so by CTRL+SHIFT+END approach conditionally and then pass those last row numbers into an append query. Below assumes tables are already created prior to running and Excel spreadsheets have exactly same columns as tables. If not, specify columns in INSERT INTO and SELECT clauses.

Function (retrieves last rows of both dataset ranges, using late-binding of Excel objects)

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

Subroutine (builds and runs dynamic action queries)

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

Importing multiple dynamic Excel Data ranges from a single sheet into MS Access

1 Answers