Импорт данных из Access в Excel с использованием Access VBA. Vba импорт данных из access в excel


Импорт данных из Access в Excel с использованием Access VBA

Я хотел бы попросить вас обратиться к коду доступа VBA, который будет импортировать все данные из 1 указанной таблицы запросов из базы данных Access (в настоящее время открытой базы данных) в MS Excel (файл, который может быть выбран пользователем).

Я в настоящее время имея этот кусок кода, но я получаю сообщение об ошибке сказав:

«Ошибка выполнения„-2147023170 (800706be)“: ошибка

Автоматизации удаленный вызов процедуры не удался. "

Кто-нибудь из вас знает, как исправить соединение?

Option Explicit Option Compare Database Public Sub CopyRstToExcel_test() 'On Error GoTo CopyRstToExcel_Err Dim sPath As String Dim fd As FileDialog Dim oExcel As Object Dim oExcelWrkBk As Object Dim oExcelWrSht As Object Dim dbs 'Added Dim qdfName As String Dim fRecords As Boolean Dim rst As dao.Recordset Dim iCols As Integer '------------------------------------------------------------------------------------------------------------------------------------------------------------------- ' Select the file and identify the path leading to the file '------------------------------------------------------------------------------------------------------------------------------------------------------------------- 'Define database you want to work with Set dbs = CurrentDb 'Select the Excel file you want to work with Set fd = Application.FileDialog(msoFileDialogFilePicker) 'Define the path If fd.Show = -1 Then sPath = fd.SelectedItems(1) End If MsgBox sPath '------------------------------------------------------------------------------------------------------------------------------------------------------------------- ' Defining names of variables '------------------------------------------------------------------------------------------------------------------------------------------------------------------- 'Defining variables (queries/tables) qdfName = "Query_1" '------------------------------------------------------------------------------------------------ 'Copying the data from Access into the new Excel '------------------------------------------------------------------------------------------------ Set rst = CurrentDb.OpenRecordset(qdfName, dbOpenSnapshot) fRecords = False If rst.EOF = False Then fRecords = True Set oExcel = CreateObject("Excel.Application") Set oExcelWrkBk = GetObject(sPath) oExcel.Visible = True oExcel.ScreenUpdating = False Set oExcelWrSht = oExcelWrkBk.Sheets(1) For iCols = 0 To rst.Fields.Count - 1 oExcelWrSht.Cells(9, iCols + 2).Value = rst.Fields(iCols).Name Next oExcelWrSht.Range(oExcelWrSht.Cells(9, 2), _ oExcelWrSht.Cells(9, rst.Fields.Count)).Font.Bold = True oExcelWrSht.Range("B10").CopyFromRecordset rst oExcelWrSht.Range(oExcelWrSht.Cells(9, 2), _ oExcelWrSht.Cells(rst.RecordCount + 9, rst.Fields.Count)).Columns.AutoFit oExcelWrSht.Range("A1").Select End If '------------------------------------------------------------------------------------------------ CopyRstToExcel_Done: On Error Resume Next If fRecords = True Then oExcel.Visible = True oExcel.ScreenUpdating = True End If Set oExcelWrSht = Nothing Set oExcelWrkBk = Nothing Set oExcel = Nothing Set rst = Nothing ''Error message: 'CopyRstToExcel_Err: ' MsgBox Err & ": " & Error, vbExclamation ' Resume CopyRstToExcel_Done ' Resume '------------------------------------------------------------------------------------------------ End Sub

На этом этапе, я только хочу, чтобы скопировать данные в первом листе, но позже я также хотел бы указать имя листа и у меня есть уже готовые шаблоны Я хочу, чтобы скопировать данных.

Благодарим за помощь!

stackoverrun.com

Импорт данных из Excel в Ms Access с помощью VB

Я пытаюсь импортировать данные из файла Excel в мою базу данных доступа к Ms. У меня есть готовая таблица в моей базе данных доступа к Ms и в форме импорта, где я нажимаю кнопку импорта (которую я создал), затем выберите файл Excel на моем компьютере и данные импортируются. Проблема заключается в том, что мой код работать только для 1 листа файла Excel, означает, что он не работает, если файл имеет несколько листов в нем, вот код, который я написал:

Private Sub ImportButton_Click() Dim dlg As FileDialog, strFileName As String Set dlg = Application.FileDialog(msoFileDialogFilePicker) With dlg .Title = "Select the Excel file to import" .AllowMultiSelect = False .Filters.Clear .Filters.Add "Excel Files", "*.xls*", 1 .Filters.Add "All Files", "*.*", If .Show = -1 Then strFileName = .SelectedItems(1) DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Personnel", strFileName, True Else Exit Sub End If End With End Sub

Так есть ли способ что я могу прокручивать листы в файле Excel один за другим? Спасибо заранее. Обновление: это новый рабочий код, если кому-то это нужно.

Private Sub Command0_Click() ' Requires reference to Microsoft Office 11.0 Object Library. Dim fDialog As FileDialog Dim varFile As Variant ' Clear listbox contents. 'Me.FileList.RowSource = "" ' Set up the File Dialog. Set fDialog = Application.FileDialog(msoFileDialogFilePicker) With fDialog .AllowMultiSelect = False .Filters.Add "Excel File", "*.xls" .Filters.Add "Excel File", "*.xlsx" If .Show = True Then 'Loop through each file selected and add it to our list box. For Each varFile In .SelectedItems ' Label3.Caption = varFile Const acImport = 0 Const acSpreadsheetTypeExcel9 = 8 ''This gets the sheets to new tables GetSheets varFile Next MsgBox ("Import data successful!") End If End With End Sub Sub GetSheets(strFileName) 'Requires reference to the Microsoft Excel x.x Object Library Dim objXL As New Excel.Application Dim wkb As Excel.Workbook Dim wks As Object 'objXL.Visible = True Set wkb = objXL.Workbooks.Open(strFileName) For Each wks In wkb.Worksheets DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ "Personnel", strFileName, True, wks.Name & "$" Next 'Tidy up wkb.Close Set wkb = Nothing objXL.Quit Set objXL = Nothing End Su

б

Примечание: «Персонал» это имя таблицы, в которой я импортирующей данные.

stackoverrun.com

Импорт данных из Access в Excel с использованием Access VBA MS Excel онлайн

Я хотел бы попросить вас о помощи с кодом доступа VBA, который будет импортировать все данные из 1 указанной таблицы запросов из базы данных Access (в настоящее время открытой базы данных) в MS Excel (файл, который может быть выбран пользователем ).

У меня в настоящее время есть этот фрагмент кода, но я получаю сообщение об ошибке:

«Ошибка времени выполнения» -2147023170 (800706be):

Ошибка автоматизации Ошибка удаленного вызова процедуры. "

Кто-нибудь из вас знает, как исправить соединение?

Option Explicit Option Compare Database Public Sub CopyRstToExcel_test() 'On Error GoTo CopyRstToExcel_Err Dim sPath As String Dim fd As FileDialog Dim oExcel As Object Dim oExcelWrkBk As Object Dim oExcelWrSht As Object Dim dbs 'Added Dim qdfName As String Dim fRecords As Boolean Dim rst As dao.Recordset Dim iCols As Integer '------------------------------------------------------------------------------------------------------------------------------------------------------------------- ' Select the file and identify the path leading to the file '------------------------------------------------------------------------------------------------------------------------------------------------------------------- 'Define database you want to work with Set dbs = CurrentDb 'Select the Excel file you want to work with Set fd = Application.FileDialog(msoFileDialogFilePicker) 'Define the path If fd.Show = -1 Then sPath = fd.SelectedItems(1) End If MsgBox sPath '------------------------------------------------------------------------------------------------------------------------------------------------------------------- ' Defining names of variables '------------------------------------------------------------------------------------------------------------------------------------------------------------------- 'Defining variables (queries/tables) qdfName = "Query_1" '------------------------------------------------------------------------------------------------ 'Copying the data from Access into the new Excel '------------------------------------------------------------------------------------------------ Set rst = CurrentDb.OpenRecordset(qdfName, dbOpenSnapshot) fRecords = False If rst.EOF = False Then fRecords = True Set oExcel = CreateObject("Excel.Application") Set oExcelWrkBk = GetObject(sPath) oExcel.Visible = True oExcel.ScreenUpdating = False Set oExcelWrSht = oExcelWrkBk.Sheets(1) For iCols = 0 To rst.Fields.Count - 1 oExcelWrSht.Cells(9, iCols + 2).Value = rst.Fields(iCols).Name Next oExcelWrSht.Range(oExcelWrSht.Cells(9, 2), _ oExcelWrSht.Cells(9, rst.Fields.Count)).Font.Bold = True oExcelWrSht.Range("B10").CopyFromRecordset rst oExcelWrSht.Range(oExcelWrSht.Cells(9, 2), _ oExcelWrSht.Cells(rst.RecordCount + 9, rst.Fields.Count)).Columns.AutoFit oExcelWrSht.Range("A1").Select End If '------------------------------------------------------------------------------------------------ CopyRstToExcel_Done: On Error Resume Next If fRecords = True Then oExcel.Visible = True oExcel.ScreenUpdating = True End If Set oExcelWrSht = Nothing Set oExcelWrkBk = Nothing Set oExcel = Nothing Set rst = Nothing ''Error message: 'CopyRstToExcel_Err: ' MsgBox Err & ": " & Error, vbExclamation ' Resume CopyRstToExcel_Done ' Resume '------------------------------------------------------------------------------------------------ End Sub

На этом этапе я хочу только скопировать данные в первый лист, но позже я также хотел бы указать имя листа, и у меня есть уже подготовленные шаблоны, которые я хочу скопировать данные.

Спасибо за помощь!

Solutions Collecting From Web of "Импорт данных из Access в Excel с использованием Access VBA"

Попробуйте заменить

Set oExcelWrkBk = GetObject(sPath)

от

Set oExcelWrkBk = oExcel.Workbooks.Open(sPath)

Также я бы рекомендовал заменить

Set rst = CurrentDb.OpenRecordset(qdfName, dbOpenSnapshot)

от

Set rst = dbs.OpenRecordset(qdfName, dbOpenSnapshot)

Открыть заданный рабочий лист:

Set oExcelWrSht = oExcelWrkBk.Sheets("MyWorksheetName")

excel.bilee.com

vba - Импорт данных из Excel в Ms Access с помощью VB

Я пытаюсь импортировать данные из файла Excel в мою базу данных доступа к Ms. У меня есть готовая таблица в моей базе данных доступа к Ms и в форме импорта, где я нажимаю кнопку импорта (которую я создал), затем выбираю файл Excel на своем компьютере и данные импортируются. Проблема в том, что мой код работает только для одного листа Excel файла, означает, что он не работает, если в нем есть несколько листов, вот код, который я написал:

Private Sub ImportButton_Click() Dim dlg As FileDialog, strFileName As String Set dlg = Application.FileDialog(msoFileDialogFilePicker) With dlg .Title = "Select the Excel file to import" .AllowMultiSelect = False .Filters.Clear .Filters.Add "Excel Files", "*.xls*", 1 .Filters.Add "All Files", "*.*", If .Show = -1 Then strFileName = .SelectedItems(1) DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Personnel", strFileName, True Else Exit Sub End If End With End Sub

Так есть способ, которым я могу зацикливать листы в файле Excel один за другим? Заранее спасибо. Обновление: это новый рабочий код, если кому-то это нужно.

Private Sub Command0_Click() ' Requires reference to Microsoft Office 11.0 Object Library. Dim fDialog As FileDialog Dim varFile As Variant ' Clear listbox contents. 'Me.FileList.RowSource = "" ' Set up the File Dialog. Set fDialog = Application.FileDialog(msoFileDialogFilePicker) With fDialog .AllowMultiSelect = False .Filters.Add "Excel File", "*.xls" .Filters.Add "Excel File", "*.xlsx" If .Show = True Then 'Loop through each file selected and add it to our list box. For Each varFile In .SelectedItems ' Label3.Caption = varFile Const acImport = 0 Const acSpreadsheetTypeExcel9 = 8 ''This gets the sheets to new tables GetSheets varFile Next MsgBox ("Import data successful!") End If End With End Sub Sub GetSheets(strFileName) 'Requires reference to the Microsoft Excel x.x Object Library Dim objXL As New Excel.Application Dim wkb As Excel.Workbook Dim wks As Object 'objXL.Visible = True Set wkb = objXL.Workbooks.Open(strFileName) For Each wks In wkb.Worksheets DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ "Personnel", strFileName, True, wks.Name & "$" Next 'Tidy up wkb.Close Set wkb = Nothing objXL.Quit Set objXL = Nothing End Su

б

Примечание. "Персонал" - это имя таблицы, в которую я импортирую данные.

qaru.site