Используем Excel как сервер, открываем таблицу.
Следующий код используется для поиска
количества используемых строк и колонок. max_row = excel_sheet.UsedRange.Rows.Count
max_col = excel_sheet.UsedRange.Columns.Count
Для открытия базы данных используем ADO.
Для каждой строки таблицы Excel в цикле
составляем инструкцию SQL INSERT. Для выполнения
инструкции и создания записи используем объект
ADO Connection. |
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
' Создаём приложение Excel.
Set excel_app = CreateObject("Excel.Application")
' Если хотите, чтобы Excel был видимым, то раскомментируйте следующую строку.
' excel_app.Visible = True
' Открываем таблицу Excel.
excel_app.Workbooks.Open FileName:=txtExcelFile.Text
' Проверяем версию.
If Val(excel_app.Application.Version) >= 8 Then
Set excel_sheet = excel_app.ActiveSheet
Else
Set excel_sheet = excel_app
End If
' Узнаём строку и колонку, которые использовались последний раз.
max_row = excel_sheet.UsedRange.Rows.Count
max_col = excel_sheet.UsedRange.Columns.Count
' Открываем базу данных Access.
Set conn = New ADODB.Connection
conn.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & txtAccessFile.Text & ";" & _
"Persist Security Info=False"
conn.Open
' Делаем цикл по строкам таблицы Excel,
' пропуская первую строку, которая содержит
' заголовки колонок.
For row = 2 To max_row
' Составляем инструкцию INSERT.
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 & ")"
' Выполняем инструкцию INSERT.
conn.Execute statement, , adCmdText
Next row
' Закрываем базу данных.
conn.Close
Set conn = Nothing
' Если хотите, чтобы Excel остался запущенным, закомментируйте строки
' Close и Quit.
' Закрываем Книгу, сохраняя изменения.
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
|