Копируем данные из таблицы Excel в базу данных Access

Компилятор: Visual Basic

Используем 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

Скачать исходник - 23 Кб