Selecting and Importing Excel File and Sheet for import into Access

• Download example - 529.3 KB

Introduction

A common requirement in Microsoft Access is the ability to import files. Compared to working with C# and Visual Basic.Net, this is somewhat different.

Implementation

The first requirement is to be able to browse to the Excel file. Here is the code that is executed in the form when the “Browse” button is clicked:

Private Sub buttonBrowse_Click()
    ' Clear out existing information before browse
    Dim itemsString As String
    textBoxExcelFileToImport = ""
    listBoxWorksheets.RowSource = ""
    subFormData.Visible = False
    DoEvents
   
    ' Allow user to browse to Excel file to import
    textBoxExcelFileToImport = GetExcelFile
    If IsNull(textBoxExcelFileToImport) Then Exit Sub
   
    ' Fill in list box that will contain the sheet names
    itemsString = Join(ExcelSheetsNameList(textBoxExcelFileToImport), ";")
    listBoxWorksheets.RowSource = itemsString
End Sub

This code first clears out information in the form that may be applicable to the last file that was selected, and then the user is provided a dialog to select a file with the “xlsx” extension. If a file is not selected, then the code returns, otherwise the Excel file is opened to find its sheet names, which are displayed in a list box to allow the user to select the sheet to import.

First the information in the Form is cleared, including clearing out the file name TextBox, the sheet names ListBox, and the hide the sub form.

Next the software must let the user select the Excel file to use. The implementation of the Browse is done in the GetExcelFile method:

Public Function GetExcelFile()
    Set fDialog = Application.FileDialog(3)
   
    With fDialog
        ' Allow user to make multiple selections in dialog box
        .AllowMultiSelect = False
        ' Set the title of the dialog box.
        .Title = "Please select Excel file to import"
        ' Clear out the current filters, and add our own.
        .Filters.Clear
        .Filters.Add "Excel 2007", "*.xlsx"
       
        ' Show the dialog box. If the .Show method returns True, the user picked a
        ' file. If the .Show method returns False, the user clicked Cancel. '
        If .Show = True Then
            GetExcelFile = .SelectedItems(1)
        Else
            GetExcelFile = Null
        End If
    End With
End Function

This method allows the user to browse to a file and returns the file path.

After the Excel file is selected, then you need to populate the sheet name ListBox with the Worksheet names. The ExcelSheetsNameList method returns the Worksheet names:

Public Function ExcelSheetsNameList(path As String) As String()
    OpenExcelWorkbook (path)
    Dim shts() As String
    ReDim shts(m_OpenWorkbook.Sheets.Count - 1)
    For x = 1 To m_OpenWorkbook.Sheets.Count
        shts(x - 1) = m_OpenWorkbook.Sheets(x).name
    Next x
    ExcelSheetsNameList = shts
End Function

The Worksheet names are returned in an Array, which has to be converted to a ";" delimited String, done in the Browse click event handler. The ListBox RowSource is set to this delimited String.

This Function uses the OpenExcelWorkbook to actually open the Workbook:

Public Function OpenExcelWorkbook(path As String)
    If m_OpenExcel Is Nothing Then
        Set m_OpenExcel = CreateObject("Excel.Application")
    End If
   
    If IsEmpty(m_OpenWorkbook) Then
        m_OpenExcel.Workbooks.Open path
        Set m_OpenWorkbook = m_OpenExcel.ActiveWorkbook
    ElseIf m_OpenWorkbook.FullName <> path Then
        m_OpenExcel.Workbooks.Open path
        Set m_OpenWorkbook = m_OpenExcel.ActiveWorkbook
    End If
End Function

This code keeps a copy of the Workbook object in the variable m_OpenWorkbook and the Excel application in m_OpenExcel so as to reduce processing. The call to NewImportUtilitiesModuleDispose in the NewImportUtilitiesModule will ensure that these objects are disposed.

Next, the user has to select a name from the Worksheet list. When a sheet is selected, it is automatically processed:

Private Sub listBoxWorksheets_Click()
    Dim sheet As Worksheet
    Dim firstCell As String
    Dim range As String
    Dim sheetRange As String
    subFormData.SourceObject = Empty
    DeleteTableSafe "T_Temp"
    DoEvents
   
    Set sheet = GetExcelWorksheet(textBoxExcelFileToImport, listBoxWorksheets)
    firstCell = FindFirstNonEmptyCell(sheet, 10)
    If firstCell = "" Then
        MsgBox "Could not find cell with content, which is the cell that should be the upper " _
		& "left corner of the contents to import"
        listBoxWorksheets = ""
    Else
        range = FindDataCells(sheet, firstCell)
        sheetRange = listBoxWorksheets & "!" & range
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "T_Temp", 
		textBoxExcelFileToImport, True, sheetRange
        subFormData.SourceObject = "Table.T_Temp"
        subFormData.Visible = True
    End If
    Set sheet = Nothing
End Sub

Before all this processing in the click event handler for the ListBox selection, the reference to the temporary table being used in the RowSource of the subform is removed by setting the RowSource to Empty. Then the temporary table is deleted. Next the Worksheet with the specified name is returned using the GetExcelWorksheet:

Public Function GetExcelWorksheet(path As String, sheetName As String) As Worksheet
    Dim Workbook As Workbook
    Dim sheet As Worksheet
    OpenExcelWorkbook (path)
    Set GetExcelWorksheet = m_OpenWorkbook.Sheets(sheetName)
End Function

This Function uses the OpenExcelWorkbook to ensure that the Workbook is open (and if not, opens it, and then returns the Worksheet with the matching name.

Then the Worksheet is searched to find the first cell that is non Empty. This is done using the Function FindFirstNonEmptyCell:

Public Function FindFirstNonEmptyCell (sheet As Worksheet, limit As Integer) As String
    For i = 1 To limit
        For j = 1 To i
            cell = sheet.cells(j, i - j + 1)
            If Not IsEmpty(cell) Then
                FindFirstNonEmptyCell = sheet.range(sheet.cells(j, i - j + 1), 
                                sheet.cells(j, i - j + 1)).address(False, False)
                Exit Function
            End If
        Next
    Next
End Function

The search is done with a search from the upper left Cell, searching the closest cells, and stopping after the specified limit, in this case 10. It returns the code for the Cell that is found (e.g. “B3”). There is also a Function that will find the first cell with the specified content, instead of the first non-empty cell (FindCellWithSpecifiedContent).
Next, the Worksheet is searched to find the first Empty Cell to the right and down from the found Cell using the Function FindDataCells:

Public Function FindDataCells(sheet As Worksheet, initalCell As String) As String
    Dim startRow, startColumn, currentRow, currentColumn As Integer
    currentRow = sheet.range(initalCell).Row
    startRow = currentRow
    currentColumn = sheet.range(initalCell).Column
    startColumn = currentColumn
   
    While Not IsEmpty(sheet.cells(currentRow, currentColumn))
        currentRow = currentRow + 1
        currentColumn = currentColumn + 1
    Wend
   
    If Not IsEmpty(sheet.cells(currentRow - 1, currentColumn)) Then
        currentRow = currentRow - 1
        While Not IsEmpty(sheet.cells(currentRow, currentColumn))
            currentColumn = currentColumn + 1
        Wend
        currentColumn = currentColumn - 1
    ElseIf Not IsEmpty(sheet.cells(currentRow, currentColumn - 1)) Then
        currentColumn = currentColumn - 1
        While Not IsEmpty(sheet.cells(currentRow, currentColumn))
            currentRow = currentRow + 1
        Wend
        currentRow = currentRow - 1
    End If
    FindDataCells = sheet.range(sheet.cells(startRow, startColumn), 
            sheet.cells(currentRow, currentColumn)).Address(False, False)
End Function

This Function will search the cells of the Worksheet to the right and down for the last non-Empty Cell by first progressing diagonally right and down, and then either right or down to find the extent of the data. It returns the code for the extent of the cells found (e.g. “B3:E56”).

Then the DoCmd.TransferSpreadsheet is executed. When that completes, the table is referenced in the subform SourceObject, and the subform is made visible.

Conclusion

This is just basic functionality, and you will probably want to modify this code to meet your specific needs.
First, the first non-Empty Cell is searched for to find the start of the table so that the data does not have to start in the first row and column. It may be preferable to look for a specific String, or just assume that the data will start in the top left cell. This allows other information to be included in the spreadsheet such that it does not interfere with the transfer.

Then there is a scan to find the last data row and column, and any empty cells will signal the code that the end of the data has been reached. This means that there cannot be empty cells in the data, at least where the scan occurs, which is diagonally and then right or down;

Another limitation is that this code is designed to work with only with spreadsheets that have been saved in newest format, and not “CSV” data. This could be easily adapted for by including the other file types in the dialog filter, and having the TransferSpreadsheet arguments modified to handle the other types.

One of the issues that could happen is that the TransferSpreadsheet is that, when creating a table, it will base a field type on the first entry, such that if the first entry is a number, than that column will be for numeric. This could cause import errors when importing data after the first row.

One thing that would be nice is if there was a way to figure out the name of the table that contains the paste errors, then it would be possible to know if there had been errors and to be able to tell the user what the errors were.

History

• 18-09-06: Initial version