Импорт таблицы excel в access vba

This tutorial will cover the ways to import data from Excel into an Access Table and ways to export Access objects (Queries, Reports, Tables, or Forms) to Excel.

Import Excel File Into Access

To import an Excel file to Access, use the acImport option of DoCmd.TransferSpreadsheet :

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C:TempBook1.xlsx", True

Or you can use DoCmd.TransferText to import a CSV file:

DoCmd.TransferText acLinkDelim, , "Table1", "C:TempBook1.xlsx", True

Import Excel to Access Function

This function can be used to import an Excel file or CSV file into an Access Table:

Public Function ImportFile(Filename As String, HasFieldNames As Boolean, TableName As String) As Boolean
' Example usage: call ImportFile ("Select an Excel File",  "Excel Files", "*.xlsx",  "C:" , True,True, "ExcelImportTest", True, True,false,True)

    On Error GoTo err_handler
  
    If (Right(Filename, 3) = "xls") Or ((Right(Filename, 4) = "xlsx")) Then
                DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames
            End If
    If (Right(Filename, 3) = "csv") Then
                DoCmd.TransferText acLinkDelim, , TableName, Filename, True
    End If
    
Exit_Thing:

    'Clean up
    'Check if our linked in Excel table already exists... and delete it if so
    If ObjectExists("Table", TableName) = True Then DropTable (TableName)
    Set colWorksheets = Nothing

    Exit Function
    
err_handler:
    If (Err.Number = 3086 Or Err.Number = 3274 Or Err.Number = 3073) And errCount < 3 Then
        errCount = errCount + 1

    ElseIf Err.Number = 3127 Then
        MsgBox "The fields in all the tabs are the same. Please make sure that each sheet has the exact column names if you wish to import mulitple", vbCritical, "MultiSheets not identical"
        ImportFile = False
        GoTo Exit_Thing
    Else
        MsgBox Err.Number & " - " & Err.Description
        ImportFile = False
        GoTo Exit_Thing
        Resume
    End If
End Function

You can call the function like this:

Private Sub ImportFile_Example()
 Call VBA_Access_ImportExport.ImportFile("C:TempBook1.xlsx", True, "Imported_Table_1")
End Sub

Access VBA Export to New Excel File

To export an Access object to a new Excel file, use the DoCmd.OutputTo method or the DoCmd.TransferSpreadsheet method:

Export Query to Excel

This line of VBA code will export a Query to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c:tempExportedQuery.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c:tempExportedQuery.xls", True

Note: This code exports to XLSX format. Instead you can update the arguments to export to a CSV or XLS file format instead (ex. acFormatXLSX to acFormatXLS).

Export Report to Excel

This line of code will export a Report to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c:tempExportedReport.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c:tempExportedReport.xls", True

Export Table to Excel

This line of code will export a Table to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c:tempExportedTable.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c:tempExportedTable.xls", True

Export Form to Excel

This line of code will export a Form to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c:tempExportedForm.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c:tempExportedForm.xls", True

Export to Excel Functions

These one line commands work great to export to a new Excel file. However, they will not be able to export into an existing workbook.  In the section below we introduce functions that allow you to append your export to an existing Excel file.

Below that, we’ve included some additional functions to export to new Excel files, including error handling and more.

Export to Existing Excel File

The above code examples work great to export Access objects to a new Excel file.  However, they will not be able to export into an existing workbook.

To export Access objects to an existing Excel workbook we’ve created the following function:

Public Function AppendToExcel(strObjectType As String, strObjectName As String, strSheetName As String, strFileName As String)

    Dim rst As DAO.Recordset
    Dim ApXL As Excel.Application
    Dim xlWBk As Excel.Workbook
    Dim xlWSh As Excel.Worksheet
    Dim intCount As Integer
    Const xlToRight As Long = -4161
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlContinuous As Long = 1
      
    Select Case strObjectType

    Case "Table", "Query"
        Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset, dbSeeChanges)
    Case "Form"
        Set rst = Forms(strObjectName).RecordsetClone
    Case "Report"
        Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges)
    End Select

    If rst.RecordCount = 0 Then
        MsgBox "No records to be exported.", vbInformation, GetDBTitle
    Else
        On Error Resume Next
        Set ApXL = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set ApXL = CreateObject("Excel.Application")
        End If
        Err.Clear

        ApXL.Visible = False
        
        Set xlWBk = ApXL.Workbooks.Open(strFileName)
        Set xlWSh = xlWBk.Sheets.Add
        xlWSh.Name = Left(strSheetName, 31)

        
        xlWSh.Range("A1").Select
        Do Until intCount = rst.fields.Count
            ApXL.ActiveCell = rst.fields(intCount).Name
            ApXL.ActiveCell.Offset(0, 1).Select
            intCount = intCount + 1
        Loop

        rst.MoveFirst
        
        xlWSh.Range("A2").CopyFromRecordset rst

        With ApXL
            .Range("A1").Select
            .Range(.Selection, .Selection.End(xlToRight)).Select
            .Selection.Interior.Pattern = xlSolid
            .Selection.Interior.PatternColorIndex = xlAutomatic
            .Selection.Interior.TintAndShade = -0.25
            .Selection.Interior.PatternTintAndShade = 0
            .Selection.Borders.LineStyle = xlNone
            .Selection.AutoFilter
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit
            .Range("B2").Select
            .ActiveWindow.FreezePanes = True
            .ActiveSheet.Cells.Select
            .ActiveSheet.Cells.WrapText = False
            .ActiveSheet.Cells.EntireColumn.AutoFit
            xlWSh.Range("A1").Select
            .Visible = True
        End With

        'xlWB.Close True
        'Set xlWB = Nothing
        'ApXL.Quit
        'Set ApXL = Nothing
    End If
End Function

You can use the function like this:

Private Sub AppendToExcel_Example()
    Call VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet", "C:TempTest.xlsx")
End Sub

Notice you are asked to define:

• What to Output? Table, Report, Query, or Form
• Object Name
• Output Sheet Name
• Output File Path and Name.

VBA Programming | Code Generator does work for you!

Export SQL Query to Excel

Instead you can export an SQL query to Excel using a similar function:

Public Function AppendToExcelSQLStatemet(strsql As String, strSheetName As String, strFileName As String)
    Dim strQueryName As String
    Dim ApXL As Excel.Application
    Dim xlWBk As Excel.Workbook
    Dim xlWSh As Excel.Worksheet
    Dim intCount As Integer
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlVAlignCenter = -4108
    Const xlContinuous As Long = 1
    Dim qdf As DAO.QueryDef
    Dim rst As DAO.Recordset
    
    strQueryName = "tmpQueryToExportToExcel"

    If ObjectExists("Query", strQueryName) Then
        CurrentDb.QueryDefs.Delete strQueryName
    End If
    Set qdf = CurrentDb.CreateQueryDef(strQueryName, strsql)
    Set rst = CurrentDb.OpenRecordset(strQueryName, dbOpenDynaset)

    If rst.RecordCount = 0 Then
        MsgBox "No records to be exported.", vbInformation, GetDBTitle
    Else
        On Error Resume Next
        Set ApXL = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set ApXL = CreateObject("Excel.Application")
        End If
        Err.Clear

        ApXL.Visible = False
        
        Set xlWBk = ApXL.Workbooks.Open(strFileName)
        Set xlWSh = xlWBk.Sheets.Add
        xlWSh.Name = Left(strSheetName, 31)

        
        xlWSh.Range("A1").Select
        Do Until intCount = rst.fields.Count
            ApXL.ActiveCell = rst.fields(intCount).Name
            ApXL.ActiveCell.Offset(0, 1).Select
            intCount = intCount + 1
        Loop

        rst.MoveFirst
        
        xlWSh.Range("A2").CopyFromRecordset rst

        With ApXL
            .Range("A1").Select
            .Range(.Selection, .Selection.End(xlToRight)).Select
            .Selection.Interior.Pattern = xlSolid
            .Selection.Interior.PatternColorIndex = xlAutomatic
            .Selection.Interior.TintAndShade = -0.25
            .Selection.Interior.PatternTintAndShade = 0
            .Selection.Borders.LineStyle = xlNone
            .Selection.AutoFilter
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit
            .Range("B2").Select
            .ActiveWindow.FreezePanes = True
            .ActiveSheet.Cells.Select
            .ActiveSheet.Cells.WrapText = False
            .ActiveSheet.Cells.EntireColumn.AutoFit
            xlWSh.Range("A1").Select
            .Visible = True
        End With


        'xlWB.Close True
        'Set xlWB = Nothing
        'ApXL.Quit
        'Set ApXL = Nothing
    End If
End Function

Called like this:

Private Sub AppendToExcelSQLStatemet_Example()
    Call VBA_Access_ImportExport.ExportToExcel("SELECT * FROM Table1", "VBASheet", "C:TempTest.xlsx")
End Sub

Where you are asked to input:

• SQL Query
• Output Sheet Name
• Output File Path and Name.

Function to Export to New Excel File

These functions allow you to export Access objects to a new Excel workbook. You might find them more useful than the simple single lines at the top of the document.

Public Function ExportToExcel(strObjectType As String, strObjectName As String, Optional strSheetName As String, Optional strFileName As String)

    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim intCount As Integer
    Const xlToRight As Long = -4161
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlContinuous As Long = 1

    On Error GoTo ExportToExcel_Err
    DoCmd.Hourglass True

    Select Case strObjectType

    Case "Table", "Query"
        Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset, dbSeeChanges)
    Case "Form"
        Set rst = Forms(strObjectName).RecordsetClone
    Case "Report"
        Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges)
    End Select

    If rst.RecordCount = 0 Then
        MsgBox "No records to be exported.", vbInformation, GetDBTitle
        DoCmd.Hourglass False
    Else
        On Error Resume Next
        Set ApXL = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set ApXL = CreateObject("Excel.Application")
        End If
        Err.Clear
        On Error GoTo ExportToExcel_Err

        Set xlWBk = ApXL.Workbooks.Add
        ApXL.Visible = False

        Set xlWSh = xlWBk.Worksheets("Sheet1")
        If Len(strSheetName) > 0 Then
            xlWSh.Name = Left(strSheetName, 31)
        End If

        xlWSh.Range("A1").Select
        Do Until intCount = rst.fields.Count
            ApXL.ActiveCell = rst.fields(intCount).Name
            ApXL.ActiveCell.Offset(0, 1).Select
            intCount = intCount + 1
        Loop

        rst.MoveFirst
        
        xlWSh.Range("A2").CopyFromRecordset rst

        With ApXL
            .Range("A1").Select
            .Range(.Selection, .Selection.End(xlToRight)).Select
            .Selection.Interior.Pattern = xlSolid
            .Selection.Interior.PatternColorIndex = xlAutomatic
            .Selection.Interior.TintAndShade = -0.25
            .Selection.Interior.PatternTintAndShade = 0
            .Selection.Borders.LineStyle = xlNone
            .Selection.AutoFilter
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit
            .Range("B2").Select
            .ActiveWindow.FreezePanes = True
            .ActiveSheet.Cells.Select
            .ActiveSheet.Cells.WrapText = False
            .ActiveSheet.Cells.EntireColumn.AutoFit
            xlWSh.Range("A1").Select
            .Visible = True
        End With

retry:
        If FileExists(strFileName) Then
            Kill strFileName
        End If
        If strFileName <> "" Then
            xlWBk.SaveAs strFileName, FileFormat:=56
        End If
        
        rst.Close
        Set rst = Nothing
        DoCmd.Hourglass False
    End If

ExportToExcel_Exit:
    DoCmd.Hourglass False
    Exit Function

ExportToExcel_Err:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    DoCmd.Hourglass False
    Resume ExportToExcel_Exit

End Function

The function can be called like this:

Private Sub ExportToExcel_Example()
 Call VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet")
End Sub

Вопрос следующий: в Access импортируются таблицы Excel с помощью обычного SELECT’a из листа —

INSERT INTO (Поля Access) SELECT Поля Excel FROM [Excel 12.0 xml;HDR=Yes;IMEX=1;DATABASE=" & currentFilePath & "]

Проблемы возникают, когда в Excel файле попадаются столбцы с нестандартными именами, содержащими в себе, например, точки.
Каким образом можно перед импортом открыть файл, c помощью REPLACE заменить точки на пробелы, и импортировать из уже отредактированного файла, не сохраняя его, чтобы не испортить исходник? Методы типа DoCmd.TransferSpreadsheet и «поячеечного» чтения не подходят, поскольку таблица содержит несколько десятков столбцов и около полумиллиона строк, что делает эти методы не совсем подходящими из-за времени выполнения.

А как после импорта для всех названий полей в таблице символ # по-быстрому на что-то иное заменить?

CurrentDb.TableDefs(Table).Fields("Field#").Name=Replace(CurrentDb.TableDefs(Table).Fields("Field#").Name, "#", "")

или вот так:

CurrentDb.TableDefs(Table).Fields(I).Name=Replace(CurrentDb.TableDefs(Table).Fields(I).Name, "#", "")

Спс, отлично сработало.
Для вар-тов кучи полей в исходных эксельках самое то.

Sub ReplaceCharInTableName(strTableName As String)

Dim bytTableFieldCount As Byte, i As Byte

bytTableFieldCount = CurrentDb.TableDefs(strTableName).Fields.Count

For i = o To bytTableFieldCount - 1

    CurrentDb.TableDefs(strTableName).Fields(i).Name = Replace(CurrentDb.TableDefs(strTableName).Fields(i).Name, "#", " ")

Next i

'MsgBox CurrentDb.TableDefs(strTableName).Fields.Count

End Sub

или вот так:

Sub ReplaceCharInTableName(strTableName As String)

Dim i As Byte

For i = 0 To CurrentDb.TableDefs(strTableName).Fields.Count - 1

    CurrentDb.TableDefs(strTableName).Fields(i).Name = Replace(CurrentDb.TableDefs(strTableName).Fields(i).Name, "#", " ")

Next

'MsgBox CurrentDb.TableDefs(strTableName).Fields.Count

End Sub

Sub ReplaceCharInFieldsName(strTableName As String) Dim fld As DAO.Field With CurrentDb With .TableDefs(strTableName) For Each fld In .Fields fld.Name = Replace(fld.Name, "#", vbNullString) Next End With End With End Sub 

Если в цифрах, то:
Табличка (пустая) о 10 текстовых полях (в именах нет решеток)
Тестовая процедура:

Public Sub Test()

    Dim i As Integer, j As Integer

    Dim st As Long

    j = 100

    Debug.Print String(10, "-")

    st = apiTimeGetTime

    For i = 1 To j

        ReplaceCharInTableName "tbl1"

    Next i

    Debug.Print "ReplaceCharInTableName", apiTimeGetTime - st

    Debug.Print String(10, "-")

    st = apiTimeGetTime

    For i = 1 To j

        ReplaceCharInFieldsName "tbl1"

    Next i

    Debug.Print "ReplaceCharInFieldsName", apiTimeGetTime - st

End Sub

importing excel into access, step by step

Introduction

In Microsoft Access, it is possible to accomplish most things in at least a couple of different ways, and importing Excel data into Access is no different. So, in this article, we show you how to import Excel into Access using the VBA language. For instance, we will be using the Excel Object Model. By learning this approach, you will learn insights regarding Microsoft Access, Microsoft Excel object model integration and, at the same time, we will present some ideas regarding DML (data manipulation language) operations against Access tables using SQL. 

Advantages of importing Excel into Access Using Excel Object Model

Other advantages of using the Excel object model are:

1. Full access to each row / column value that allows complex validations, lookup processes and data cleanup
2. Data type conversion

• Access to all Excel object model functions if required

Let’s Start Importing Excel Into Access using VBA

To create the final outcome the reader will need

1. A test excel file
2. A Microsoft Access database with one table and a single form with a button

The first step will be to obtain some Excel sample data to test the load process. Once generating several lines of dummy data is a tedious process a simpler approach is to download some sample test data, I found this sample file

http://www.sample-videos.com/xls/Sample-Spreadsheet-10000-rows.xls

In the same page the reader will find other smaller and bigger files. The selected file layout is as follows

There are ten columns present without column headings.

In this example we will import columns A, B and G into the destination database table.

Let’s start …

After creating an empty Microsoft Access database, the user should create an empty table with the layout presented below

The table field ItemId will be mapped to column A, the field Description will be mapped to column B and the field Price to column G. The reader should pay attention to the field price underlying data type. Once source data can have decimal numbers the destination field should be able to accommodate them (remember when working with SQL the decimal separator is the dot). The first field is simply an integer sequence and the second one a description text string (more notes on this later on).

Once the table is properly created the next step will be the creation of a simple form with a button to trigger the process. Assuming the reader already has some Microsoft Access experience the final form should be similar to

Change the button property caption to Import Excel and the button name to cmdImportExcel (as mentioned in previous tutorial, naming conventions are always a good practice). Click the save button and name the form as frmImportExcel.

To provide some user friendly features the created button will call a file picker control dialog, this way the user will be able to select the source file from the hard-drive picking it from any location.

Right click on the insert button, choose build event and then code builder. The Visual Basic editor should open

As a side not let’s force explicit variable declaration in the code so each required variable is declared using its proper data type and no machine resources are allocated in vain. In the top of the code (bellow Option Compare Database) simply add

Option Explicit

From now on all required variables will require a proper declaration.

Before implementing the code let’s explain the underlying sequence logic:

1. The user will see a file picker dialog opening
2. The user will be able to pick the excel file

• If an Excel file was picked its path will be assigned to a variable

1. The path stored in that variable will be used to open the Excel in background and load all rows into the Access table

Implementing the file dialog control

To use the file dialog control, we must provide a reference to the Microsoft Office XX Object Library (will depend on the office version installed). To do that access the Tools -> References menu in the VBA editor.

Navigate down using the scroll bar and choose the installed Office object library installed.

From now on all objects and methods provided by it are available to use.

Let’s add the file dialog picker underlying code…

In the VBA editor, inside cmdImportExcel_Click() event put the following code. The code is highly commented so the reader understands what each line is doing.

Private Sub cmdImportExcel_Click()

On Error GoTo cmdImportExcel_Click_err:

Dim fdObj As Office.FileDialog ‘declares variable fdObj

Dim varfile As Variant ‘variant type variable that will store the selected file path

Set fdObj = Application.FileDialog(msoFileDialogFilePicker) ‘instantiates the variable creating a filepicker object using late binding

With fdObj ‘using the with statement we will be working with fdObj by default

‘does not allow selecting more than one file

.allowmultiselect = False

‘clears the file dialog file type existing filters

.Filters.Clear

‘this file dialog will only allow the selection of xlsx files

.Filters.Add “Excel 2007+”, “*.xlsx”

‘optional, set the file dialog title

.Title = “Please select the excel file to import …”

.Show

If .SelectedItems.Count = 1 Then ‘a file was selected

Call MsgBox(“The selected file was: ” & .SelectedItems(1)) ‘for now we will test the file picking by sending the file path to a message box on screen

Else ‘no file was selected

Call MsgBox(“No file was selected.”)

End If

End With

Exit Sub

cmdImportExcel_Click_err:

Select Case Err.Number

Case Else

Call MsgBox(Err.Number & ” – ” & Err.Description, vbCritical + vbOKOnly, “System Error …”)

End Select

End Sub

Now let’s test the code and check how it works. First let’s visualize the form view by clicking as presented in the next picture

Then the form will be presented

The reader should now press the Import Excel button and a file picker dialog will be presented

Next please select the downloaded file, hit the open button and the outcome should be similar to the one bellow only showing a proper path

If this is the outcome, everything is working as expected and the file picking component is working already. Next we will see how to include the Excel object model into the Microsoft Access solution. The reader will have to include the proper reference to the Excel object model. Once again, access the Tools -> References menu in the VBA editor.

And mark the check box reference to the Excel application

From now on all Excel object methods and properties will be available once an Excel variable is created inside the Microsoft Access VBA code. This technique is called early binding, data types are known in advance but checking these references is not mandatory. If those references are not set a late binding technique is being used but it will make development more difficult as the code editor intellisense will not show the properties and methods, deep documentation reading will be required. A common approach is to use the reference while developing and removing it when finished, the unknown constants must then be replaced by their corresponding integer values. We will not get into much more detail but it is important to be aware these references are not mandatory, they just make life easier.

Once the reference to Excel is created we can declare variables types defined there. We will need to declare three variables

1. xlApp – will be a reference to a hidden Excel application
2. xlWb – will be a reference to the workbook opened as a result of opening the file to import

• xlWs – will be a reference to the worksheet having data to import

The steps involved in the load process can be described as follows

1. Delete existing data in destination table
2. Loop through all excel lines running an insert statement per line until the last line is reached

• The loop process will stop when it does not find any more data in the column A

The required code for the entire process is the following. We will add extensive comments on all lines, please check them bellow in green

Private Sub cmdImportExcel_Click()

On Error GoTo cmdImportExcel_Click_err:

Dim fdObj As Office.FileDialog ‘declares variable fdObj

Dim varfile As Variant ‘variant type variable that will store the selected file path

Set fdObj = Application.FileDialog(msoFileDialogFilePicker) ‘instantiates the variable creating a filepicker object using early binding

With fdObj ‘using the with statement we will be working with fdObj by default

‘does not allow selecting more than one file

.allowmultiselect = False

‘clears the file dialog file type existing filters

.Filters.Clear

‘this file dialog will only allow the selection of excel files, this is achieved handling the Filters collection

.Filters.Add “Excel 2003”, “*.xls”

.Filters.Add “Excel 2007+”, “*.xlsx”

‘optional set the file dialog title

.Title = “Please select the excel file to import …”

.Show

If .SelectedItems.Count = 1 Then ‘a file was selected so data can be imported from Excel from this point the loop import process will run

‘variables declaration

Dim xlApp As Excel.Application ‘the excel application

Dim xlWb As Excel.Workbook ‘the excel workbook reference that will point to the opened workbook

Dim xlWs As Excel.Worksheet ‘the excel worksheet with data

Dim intLine As Long ‘the line counter

Dim strSqlDml As String ‘string variable that stores the executed SQL statements

Dim strColumnBcleaned As String ‘string variable that stores values from column B after replacing single quotes by four single quotes

‘remember the quote is the string delimiter in SQL so it needs to be escaped

Dim strColumnGcleaned As String ‘string variable that stores values from column G cleaned, the clean step replaces commas by dots as

‘the decimal separator in SQL is the dot

varfile = .SelectedItems(1) ‘picking the selected file full path

clean the existing table

CurrentDb.Execute “DELETE * FROM tblExcelImport”, dbFailOnError

‘instantiate the Excel application, creating the Excel application in memory, the excel Accplication will be visible so the user is able to see the loop iterating through Excel rows but usually it is hidden and only visible if indeed required

Set xlApp = New Excel.Application

xlApp.Visible = True

‘opening the picked file by calling the Excel workbooks collection open method, it receives the file location as parameter and returns a reference for the opened file

Set xlWb = xlApp.Workbooks.Open(varfile)

‘seting the worksheet to the first one within the available, as it is the one having data to be imported

Set xlWs = xlWb.Worksheets(1)

‘default counter initial value/line, this means we start iterating in line one

intLine = 1

Do

‘the next two lines replace single quotes in column B value and commas by dots as decimal separator in column G

strColumnBcleaned = Replace(xlWs.Cells(intLine, 2).Value2, “‘”, “”””)

strColumnGcleaned = Replace(xlWs.Cells(intLine, 7).Value2, “‘”, “”””)

‘the next line creates a SQL insert statement using the previous obtained cleaned variables and the value for column A

The insert statement must have the sequence present in the destination table and is obtained by concatenating values per each line presented in the Excel file while iterating

strSqlDml = “INSERT INTO tblExcelImport VALUES(” & xlWs.Cells(intLine, 1).Value2 & “, ‘” & strColumnBcleaned & “‘, ” & strColumnGcleaned & “)”

‘executes the insert statement against the database, the dbFailOnError is an optional value that will make the Execute process return an error if the SQL was not properly executed

CurrentDb.Execute strSqlDml, dbFailOnError

‘the next line only puts the selected cell in Excel in the actual line position, this is not required and will even make the process slower, it is just present here so the reader can see things running

xlWs.Cells(intLine, 1).Select

intLine = intLine + 1

Loop Until IsEmpty(xlWs.Cells(intLine, 1)) ‘stopping criteria, when values in column A stop the loop will stop, please note in cells collection the first index is the row and the second one the column so we are making row changing. Once the loop stops the steps after close the open workbook, quit excel and clean the memory references to the created objects

xlWb.Close False

xlApp.Quit

Set xlApp = Nothing

Set xlWb = Nothing

Set xlWs = Nothing

‘the next step opens the loaded table so the user can see imported data

DoCmd.OpenTable “tblExcelImport”, acViewNormal, acEdit

‘this branch only happens if no file was selected

Else ‘no file was selected

Call MsgBox(“No file was selected.”)

End If

End With

Exit Sub

cmdImportExcel_Click_err:

Select Case Err.Number

Case Else

Call MsgBox(Err.Number & ” – ” & Err.Description, vbCritical + vbOKOnly, “System Error …”)

End Select

End Sub

As mentioned before, this is not the only approach to import Excel data, it is possible to create linked tables and, to import data into Microsoft Access, the reader should also consider the DoCmd.TransferDatabase method as well. Linked tables can make use of connectivity drivers so they may not point only to databases, it is even possible to create a linked table to a text file.

Some relevant examples related to the IN clause can be found over here

https://msdn.microsoft.com/en-us/library/bb177907(v=office.12).aspx

To run a query in Access pulling data from an Excel file a similar solution to the following one can be used

SELECT CustomerID, CompanyName

FROM [Customers$]

IN “c:documentsxldata.xls” “EXCEL 5.0;”

WHERE CustomerID Like “A*”

ORDER BY CustomerID;

Also, when dealing with SQL statements built dynamically it is very important to handle possible null values, replacing them by default values or even forcing the null value insert.

If a value can be null the variable needs to be of type Variant to store it and then use it in the built insert statement.

Conclusion

Thanks for reading about how to import excel into Access. Leave a comment if you have any questions on how to import excel into access.

Looking for a job?

Find A Job via Jooble

Option Explicit

Sub AddRecordsIntoAccessTable()
        
    '-----------------------------------------------------------------------------
    'The macro opens the Sample.accdb database and adds the 7 rows from the sheet
    '"Excel Data" in the "Customers" table of the database.
    'The code uses late binding, so no reference to external library is required.
    
    'Written By:    Christos Samaras
    'Date:          27/06/2020
    'E-mail:        [email protected]
    'Site:          https://myengineeringworld.net
    '-----------------------------------------------------------------------------

    'Declaring the necessary variables.
    Dim accessFile  As String
    Dim accessTable As String
    Dim sht         As Worksheet
    Dim lastRow     As Long
    Dim lastColumn  As Integer
    Dim con         As Object
    Dim rs          As Object
    Dim sql         As String
    Dim i           As Long
    Dim j           As Integer
            
    'Disable the screen flickering.
    Application.ScreenUpdating = False
    
    'Specify the file path of the accdb file. You can also use the full path of the file like this:
    'AccessFile = "C:UsersChristosDesktopSample.accdb"
    accessFile = ThisWorkbook.Path & "" & "Sample.accdb"
         
    'Ensure that the Access file exists.
    If FileExists(accessFile) = False Then
        MsgBox "The Access file doesn't exist!", vbCritical, "Invalid Access file path"
        Exit Sub
    End If
    
    'Set the name of the table you want to add the data.
    accessTable = "Customers"
                
    'Set the worksheet that contains the data.
    On Error Resume Next
    Set sht = ThisWorkbook.Sheets("Excel Data")
    If Err.Number <> 0 Then
        MsgBox "The given worksheet does not exist!", vbExclamation, "Invalid Sheet Name"
        Exit Sub
    End If
    Err.Clear
        
    'Find the last row and last column in the given worksheet.
    With sht
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With
    
    'Check if there are data in the worksheet.
    If lastRow < 2 Or lastColumn < 1 Then
        MsgBox "There are no data in the given worksheet!", vbCritical, "Empty Data"
        Exit Sub
    End If
        
    'Create the ADODB connection object.
    Set con = CreateObject("ADODB.connection")
    
    'Check if the object was created.
    If Err.Number <> 0 Then
        MsgBox "The connection was not created!", vbCritical, "Connection Error"
        Exit Sub
    End If
    Err.Clear
    
    'Open the connection.
    con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & accessFile
    
    'Create the SQL statement to retrieve the table data (the entire table).
    sql = "SELECT * FROM " & accessTable
    
    'Create the ADODB recordset object.
    Set rs = CreateObject("ADODB.Recordset")
    
    'Check if the object was created.
    If Err.Number <> 0 Then
        Set rs = Nothing
        Set con = Nothing
        MsgBox "The recordset was not created!", vbCritical, "Recordset Error"
        Exit Sub
    End If
    Err.Clear
             
    'Set the necessary recordset properties.
    rs.CursorType = 1   'adOpenKeyset on early binding
    rs.LockType = 3     'adLockOptimistic on early binding
        
    'Open the recordset.
    rs.Open sql, con
    
    'Add the records from Excel to Access by looping through the rows and columns of the given worksheet.
    'Here the headers are in the row 1 and they are identical to the Access table headers.
    'This is the reason why, for example, there are no spaces in the headers of the sample worksheet.
    For i = 2 To lastRow
        rs.AddNew
        For j = 1 To lastColumn
            'This is how it will look like the first time (i = 2, j = 1):
            'rs("FirstName") = "Bob"
            rs(sht.Cells(1, j).Value) = sht.Cells(i, j).Value
        Next j
        rs.Update
    Next i
        
    'Close the recordet and the connection.
    rs.Close
    con.Close
    
    'Release the objects.
    Set rs = Nothing
    Set con = Nothing
    
    'Re-enable the screen.
    Application.ScreenUpdating = True

    'Inform the user that the macro was executed successfully.
    MsgBox lastRow - 1 & " rows were successfully added into the '" & accessTable & "' table!", vbInformation, "Done"
    
End Sub

Function FileExists(FilePath As String) As Boolean
 
    '--------------------------------------------------
    'Checks if a file exists (using the Dir function).
    '--------------------------------------------------
 
    On Error Resume Next
    If Len(FilePath) > 0 Then
        If Not Dir(FilePath, vbDirectory) = vbNullString Then FileExists = True
    End If
    On Error GoTo 0
 
End Function 

Page last modified: October 3, 2021

Add Content Block