Copy data from an Excel spreadsheet into an Access database

[nandagopal]

Using Excel as a server, open the spreadsheet. Use this code to find the largest rows and columns used.

    max_row = excel_sheet.UsedRange.Rows.Count
    max_col = excel_sheet.UsedRange.Columns.Count

Use ADO to open the database.

For each row in the Excel spreadsheet, loop through the row's columns composing an SQL INSERT statement. Use the ADO Connection object to execute the statement and create the record.

Code Select Expand

Private Sub cmdLoad_Click()
Dim excel_app As Object
Dim excel_sheet As Object
Dim max_row As Integer
Dim max_col As Integer
Dim row As Integer
Dim col As Integer
Dim conn As ADODB.Connection
Dim statement As String
Dim new_value As String

    Screen.MousePointer = vbHourglass
    DoEvents

    ' Create the Excel application.
    Set excel_app = CreateObject("Excel.Application")

    ' Uncomment this line to make Excel visible.
'    excel_app.Visible = True

    ' Open the Excel spreadsheet.
    excel_app.Workbooks.Open FileName:=txtExcelFile.Text

    ' Check for later versions.
    If Val(excel_app.Application.Version) >= 8 Then
        Set excel_sheet = excel_app.ActiveSheet
    Else
        Set excel_sheet = excel_app
    End If

    ' Get the last used row and column.
    max_row = excel_sheet.UsedRange.Rows.Count
    max_col = excel_sheet.UsedRange.Columns.Count

    ' Open the Access database.
    Set conn = New ADODB.Connection
    conn.ConnectionString = _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & txtAccessFile.Text & ";" & _
        "Persist Security Info=False"
    conn.Open

    ' Loop through the Excel spreadsheet rows,
    ' skipping the first row which contains
    ' the column headers.
    For row = 2 To max_row
        ' Compose an INSERT statement.
        statement = "INSERT INTO Books VALUES ("
        For col = 1 To max_col
            If col > 1 Then statement = statement & ","
            new_value = Trim$(excel_sheet.Cells(row, _
                col).Value)
            If IsNumeric(new_value) Then
                statement = statement & _
                    new_value
            Else
                statement = statement & _
                    "'" & _
                    new_value & _
                    "'"
            End If
        Next col
        statement = statement & ")"

        ' Execute the INSERT statement.
        conn.Execute statement, , adCmdText
    Next row

    ' Close the database.
    conn.Close
    Set conn = Nothing

    ' Comment the Close and Quit lines to keep
    ' Excel running so you can see it.

    ' Close the workbook saving changes.
    excel_app.ActiveWorkbook.Close True
    excel_app.Quit

    Set excel_sheet = Nothing
    Set excel_app = Nothing

    Screen.MousePointer = vbDefault
    MsgBox "Copied " & Format$(max_row - 1) & " values."
End Sub

[zlatan24]

I've heard about many tools for opening and working office documents, but only some programs are able to help really. One of them the next. It was found a soft portal several weeks ago. And proved me that would manage with some other trouble connected with ms office and excel too - repair and fix Excel files.