Import excel rows into MS-Access without header, VBA, TransferSpreadsheet method

Question

(Using MS Office Professional Plus 2016)

I adapted this sub procedure to import MS-Excel files/their first worksheet (called "Table") into an MS-Access database. The code navigates to the indicated folder and imports all .xls files in that folder. All .xls files have the same formatting. I'm using the DoCmd.TransferSpreadsheet and a Do While.

But, the relevant data in the "Table" worksheets in the individual .xls files starts at line 29, the field names are in line 28.

My question is: Is there a way to only import the field names in line 28 and the data from line 29 to the last non-empty row - a way to include this in the Do While? Maybe with the Range option in the TransferSpreadsheet command, but I don't know how to express in the range "line x to last non-empty row".

Option Compare Database

Sub importfiles()

Dim blnHasFieldNames As Boolean
Dim strWorksheet As String, strTable As String
Dim strPath As String, strPathFile As String

' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False

' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "E:\importfiles\"

' Replace worksheetname with the real name of the worksheet that is to be
' imported from each file
strWorksheet = "Table"

' Import the data from each workbook file in the folder
strFile = Dir(strPath & "*.xls")
Do While Len(strFile) > 0
      strPathFile = strPath & strFile
      strTable = "tbl_" & Left(strFile, InStrRev(strFile, ".xls") - 1)

      DoCmd.TransferSpreadsheet acImport, _
            acSpreadsheetTypeExcel9, strTable, strPathFile, _
            blnHasFieldNames, strWorksheet & "$"

      ' Uncomment out the next code step if you want to delete the
      ' EXCEL file after it's been imported
      ' Kill strPathFile

      strFile = Dir()
Loop
MsgBox ("The sub was run.")

End Sub


Public Function runImport()

Call importfiles

End Function

(I slightly adapted this code from http://www.accessmvp.com/KDSnell/EXCEL_Import.htm#ImpWktFilesSepTbls)


EDIT:
[Type mismatch, see Max's answer][1]
 [Screenshot of excel file][2]

 [access table][3]

 [Compile error(see Max's answer)][4]


[for max][5]
[for max2][6]
[for max3][7]


  [1]: https://i.stack.imgur.com/PZFnl.png
  [2]: https://i.stack.imgur.com/IjvKc.png
  [3]: https://i.stack.imgur.com/jzOXu.png
  [4]: https://i.stack.imgur.com/uHUTK.png
  [5]: https://i.stack.imgur.com/slAeG.png
  [6]: https://i.stack.imgur.com/g6fNr.png
  [7]: https://i.stack.imgur.com/gFNqA.png

As far as i know transferspreadsheet imports only rows, that fit into the table. If you set the column-definition e.g. to "integer" for the first row and the excel is empty or text in the first 28 rows, does lines will not be imported. Try to find a column, where only rows 28:X fulfill a specific requirement, and set this in your table. — Max
Thanks for the suggestion. I did set the first column to integer, only the relevant data has an integer (number) in the first column of the worksheets. I get the error message: Run-time error '2391': Field 'F1' doesn't exist in the destination table 'Test1212'. Transferspreadsheet doesn't seem to care about this. Maybe there is some code that deletes the irrelevant header in the respective excel worksheet before every import? — fecotin

Max Max · Accepted Answer · 2019-12-12T13:01:29

here a suggestion, that opens the excel file befor importing and defines the area to import. The minus 27 ist more or less guessed, please check in the excel for the area - it might be differend, just change the number. The second change is that you define the area to import in the transferspreadsheet-command.

I hope this helps. Max

Sub importfiles()

Dim blnHasFieldNames As Boolean
Dim strWorksheet As String, strTable As String
Dim strPath As String, strPathFile As String

' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False

' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "E:\importfiles\"

' Replace worksheetname with the real name of the worksheet that is to be
' imported from each file
strWorksheet = "Table"

' Import the data from each workbook file in the folder
strFile = Dir(strPath & "*.xls")
Do While Len(strFile) > 0
      strPathFile = strPath & strFile



''''alter the excel file
        Call alter_excel(strPathFile, strWorksheet)

      DoCmd.TransferSpreadsheet acImport, _
            acSpreadsheetTypeExcel9, strTable, strPathFile, _
            blnHasFieldNames, "importarea"

      ' Uncomment out the next code step if you want to delete the
      ' EXCEL file after it's been imported
      ' Kill strPathFile

      strFile = Dir()
Loop
MsgBox ("The sub was run.")

End Sub

Function alter_excel(file As String, table As String)
Dim oXL As New Excel.Application
Dim oWB As Excel.Workbook
     Set oXL = CreateObject("Excel.Application") 
     Set oWB = oXL.Workbooks.Open(file)
        oWB.Activate
        Sheets(table).Select
        Range("A30:D" & WorksheetFunction.CountA(Columns(1)) + 5).Name = "importarea"

        oWB.Close True
        Set oWB = Nothing
        Set oXL = Nothing
End Function

Import excel rows into MS-Access without header, VBA, TransferSpreadsheet method

2 Answers