Access VBA import workbook to Access using Transferspreadsheet

This Access tutorial explains how to import workbook to Access using DoCmd.Transferspreadsheet Method, such as importing specific worksheet to Access, importing multiple worksheets to Access.

You may also want to read:

Access VBA DoCmd.OutputTo Method

Access Export all Queries to Excel

Access VBA import workbook to Access using DoCmd.Transferspreadsheet

Access VBA DoCmd.Transferspreadsheet Method is used to import workbook to Access and export Access to workbook, I have briefly demonstrated both export Excel and import Excel in my previous post. In this post I will focus on the import workbook to Access in different scenarios, such as importing a single worksheet to Access, importing multiple worksheets to Access, and importing all workbooks all worksheets to Access, in a single Access Table or separate Table.

Import Worksheet to Access (import one worksheet in a workbook)

Let’s say we have the a workbook under C:\test\test.xlsx, which contains one worksheet inside. We want to import this worksheet to Access Table.

The below Procedure imports the data including headers into Access table “importTable”.

Public Sub import()
 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "importTable", "C:\test\test.xlsx", True
End Sub

If the table “importTable” does not exist, a new Table will be created.

TransferSpreadSheet_04

 

If the table already exists and contains data, the newly imported data will be appended. The below example shows how the Table looks like after importing the same file twice.

TransferSpreadSheet_05

Creating a Table before import also ensure the data type of each field is what you expect; otherwise the data type will be automatically determined.

Import particular worksheet to Access Table

Suppose we have two worksheets in the above example, one is called 2016, another is 2017. In order to import particular worksheet, we have to make use of the Range argument in Transferspreadsheet Method.

TransferSpreadsheet(TransferType, SpreadsheetType, TableName, FileName, HasFieldNames, Range, UseOA)

Let’s say we want to import worksheet 2016 only. Because we have to specify the exact Range to import, just type any Range larger than the required Range, empty Range will not be imported. I use column IU because it is the maximum allowed number of columns (255) in Access.

Public Sub import()
 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "importTable", "C:\test\test.xlsx", True, "2016!A1:IU9999"
End Sub

Import all worksheets to the same Access Table

Suppose we want to import worksheet 2016 and worksheet 2017 in the same Access Table “importTable”.

Press ALT+F11, insert the below Procedure in a Module. What the Procedure does is to loop through the Workbook and then store the each worksheet name in Array nameList(), then import all the worksheets into Table importTable.

Public Sub import()
 Dim nameList()
 wkbookPath = "C:\test\test.xlsx"

Dim XL As Object
 Set XL = CreateObject("Excel.Application")
 With XL
 .Visible = False
 .DisplayAlerts = False
 .Workbooks.Open wkbookPath
 For Each ws In XL.Worksheets
 ReDim Preserve nameList(counter)
 nameList(counter) = ws.Name
 counter = counter + 1
 Next
 .ActiveWorkbook.Close (True)
 .Quit
 End With
 Set XL = Nothing


 For i = LBound(nameList()) To UBound(nameList())
 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "importTable", "C:\test\test.xlsx", True, nameList(i) & "!A1:IU9999"
 Next i
End Sub

Result

Import all worksheets to separate Access Table

A little modification to the TransferSpreadsheet parameters to import all worksheets to separate Access Table. Suppose we want to import 2016 worksheet and 2017 worksheet to separate Access Tables.

Public Sub import()
 Dim nameList()
 wkbookPath = "C:\test\test.xlsx"

Dim XL As Object
 Set XL = CreateObject("Excel.Application")
 With XL
 .Visible = False
 .DisplayAlerts = False
 .Workbooks.Open wkbookPath
 For Each ws In XL.Worksheets
 ReDim Preserve nameList(counter)
 nameList(counter) = ws.Name
 counter = counter + 1
 Next
 .ActiveWorkbook.Close (True)
 .Quit
 End With
 Set XL = Nothing


 For i = LBound(nameList()) To UBound(nameList())
 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, nameList(i), "C:\test\test.xlsx", True, nameList(i) & "!A1:IU9999"
 Next i
End Sub

Result

 

Import all workbook all worksheets to separate Access Table

The below Procedure imports all workbooks (and all worksheets) with xlsx extension under c:\test\ to separate Access Table.

Public Sub import()
    Dim FileName, FilePathName, Path, FileNameList() As String
    Dim FileCount As Integer
    Path = "C:\test\"
    FileName = Dir(Path & "")   

    While FileName <> "" And Right(FileName, 4) = "xlsx"
        FileCount = FileCount + 1
        ReDim Preserve FileNameList(1 To FileCount)
        FileNameList(FileCount) = FileName
        FileName = Dir()
    Wend
   
    If FileCount > 0 Then
        For FileCount = 1 To UBound(FileNameList)
            FilePathName = Path & FileNameList(FileCount)
            loopWS (FilePathName)
        Next
    End If
End Sub

Public Function loopWS(wkbookPath)
    Dim nameList()
    Dim XL As Object
    Set XL = CreateObject("Excel.Application")
    With XL
    .Visible = False
      .DisplayAlerts = False
      .Workbooks.Open wkbookPath
        For Each ws In XL.Worksheets
            ReDim Preserve nameList(counter)
            nameList(counter) = ws.Name
            counter = counter + 1
        Next
      .ActiveWorkbook.Close (True)
      .Quit
    End With
    Set XL = Nothing   
    For i = LBound(nameList()) To UBound(nameList())
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, nameList(i), wkbookPath, True, nameList(i) & "!A1:IU9999"
    Next i
End Function

If you want to import all workbooks all worksheets to the same Table called “importTable”, replace the code in blue color with the followings

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12,"importTable", wkbookPath, True, nameList(i) & "!A1:IU9999"

 

Leave a Reply

Your email address will not be published. Required fields are marked *