15 мая "Исходники.РУ" отмечают 20-летие присутствия в сети!
Поздравляем всех причастных и неравнодушных с юбилеем сайта!
И огромное спасибо всем, кто был с нами все эти годы!

Главная Информер Журнал Форум Wiki DRKB Discuz!ML Помощь проекту


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