|
|
Title | Copy data from an Excel spreadsheet into an Access database |
Keywords | ADO, Access, Excel, database |
Categories | Database, Office |
|
|
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.
|
|
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
|
|
This example is as much an exercise in manipulating the database and the Excel server as an efficient way to move data.
For a more efficient way to transfer the data, see
Use SQL to copy data from an Excel spreadsheet into an Access database.
|
|
|
|
|
|