MyTetra Share
Делитесь знаниями!
Копируем данные из таблицы Excel в базу данных Access
10.10.2019
07:26
Текстовые метки: VBA Access, CopyFromRecordset , Recordset, DAO
Раздел: !Закладки - VBA - Access - Excel->Access


Копируем данные из таблицы 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 Кб

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования