Import export access excel

This tutorial will cover the ways to import data from Excel into an Access Table and ways to export Access objects (Queries, Reports, Tables, or Forms) to Excel.

Import Excel File Into Access

To import an Excel file to Access, use the acImport option of DoCmd.TransferSpreadsheet :

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C:TempBook1.xlsx", True

Or you can use DoCmd.TransferText to import a CSV file:

DoCmd.TransferText acLinkDelim, , "Table1", "C:TempBook1.xlsx", True

Import Excel to Access Function

This function can be used to import an Excel file or CSV file into an Access Table:

Public Function ImportFile(Filename As String, HasFieldNames As Boolean, TableName As String) As Boolean
' Example usage: call ImportFile ("Select an Excel File",  "Excel Files", "*.xlsx",  "C:" , True,True, "ExcelImportTest", True, True,false,True)

    On Error GoTo err_handler
  
    If (Right(Filename, 3) = "xls") Or ((Right(Filename, 4) = "xlsx")) Then
                DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames
            End If
    If (Right(Filename, 3) = "csv") Then
                DoCmd.TransferText acLinkDelim, , TableName, Filename, True
    End If
    
Exit_Thing:

    'Clean up
    'Check if our linked in Excel table already exists... and delete it if so
    If ObjectExists("Table", TableName) = True Then DropTable (TableName)
    Set colWorksheets = Nothing

    Exit Function
    
err_handler:
    If (Err.Number = 3086 Or Err.Number = 3274 Or Err.Number = 3073) And errCount < 3 Then
        errCount = errCount + 1

    ElseIf Err.Number = 3127 Then
        MsgBox "The fields in all the tabs are the same. Please make sure that each sheet has the exact column names if you wish to import mulitple", vbCritical, "MultiSheets not identical"
        ImportFile = False
        GoTo Exit_Thing
    Else
        MsgBox Err.Number & " - " & Err.Description
        ImportFile = False
        GoTo Exit_Thing
        Resume
    End If
End Function

You can call the function like this:

Private Sub ImportFile_Example()
 Call VBA_Access_ImportExport.ImportFile("C:TempBook1.xlsx", True, "Imported_Table_1")
End Sub

Access VBA Export to New Excel File

To export an Access object to a new Excel file, use the DoCmd.OutputTo method or the DoCmd.TransferSpreadsheet method:

Export Query to Excel

This line of VBA code will export a Query to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c:tempExportedQuery.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c:tempExportedQuery.xls", True

Note: This code exports to XLSX format. Instead you can update the arguments to export to a CSV or XLS file format instead (ex. acFormatXLSX to acFormatXLS).

Export Report to Excel

This line of code will export a Report to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c:tempExportedReport.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c:tempExportedReport.xls", True

Export Table to Excel

This line of code will export a Table to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c:tempExportedTable.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c:tempExportedTable.xls", True

Export Form to Excel

This line of code will export a Form to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c:tempExportedForm.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c:tempExportedForm.xls", True

Export to Excel Functions

These one line commands work great to export to a new Excel file. However, they will not be able to export into an existing workbook.  In the section below we introduce functions that allow you to append your export to an existing Excel file.

Below that, we’ve included some additional functions to export to new Excel files, including error handling and more.

Export to Existing Excel File

The above code examples work great to export Access objects to a new Excel file.  However, they will not be able to export into an existing workbook.

To export Access objects to an existing Excel workbook we’ve created the following function:

Public Function AppendToExcel(strObjectType As String, strObjectName As String, strSheetName As String, strFileName As String)

    Dim rst As DAO.Recordset
    Dim ApXL As Excel.Application
    Dim xlWBk As Excel.Workbook
    Dim xlWSh As Excel.Worksheet
    Dim intCount As Integer
    Const xlToRight As Long = -4161
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlContinuous As Long = 1
      
    Select Case strObjectType

    Case "Table", "Query"
        Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset, dbSeeChanges)
    Case "Form"
        Set rst = Forms(strObjectName).RecordsetClone
    Case "Report"
        Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges)
    End Select

    If rst.RecordCount = 0 Then
        MsgBox "No records to be exported.", vbInformation, GetDBTitle
    Else
        On Error Resume Next
        Set ApXL = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set ApXL = CreateObject("Excel.Application")
        End If
        Err.Clear

        ApXL.Visible = False
        
        Set xlWBk = ApXL.Workbooks.Open(strFileName)
        Set xlWSh = xlWBk.Sheets.Add
        xlWSh.Name = Left(strSheetName, 31)

        
        xlWSh.Range("A1").Select
        Do Until intCount = rst.fields.Count
            ApXL.ActiveCell = rst.fields(intCount).Name
            ApXL.ActiveCell.Offset(0, 1).Select
            intCount = intCount + 1
        Loop

        rst.MoveFirst
        
        xlWSh.Range("A2").CopyFromRecordset rst

        With ApXL
            .Range("A1").Select
            .Range(.Selection, .Selection.End(xlToRight)).Select
            .Selection.Interior.Pattern = xlSolid
            .Selection.Interior.PatternColorIndex = xlAutomatic
            .Selection.Interior.TintAndShade = -0.25
            .Selection.Interior.PatternTintAndShade = 0
            .Selection.Borders.LineStyle = xlNone
            .Selection.AutoFilter
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit
            .Range("B2").Select
            .ActiveWindow.FreezePanes = True
            .ActiveSheet.Cells.Select
            .ActiveSheet.Cells.WrapText = False
            .ActiveSheet.Cells.EntireColumn.AutoFit
            xlWSh.Range("A1").Select
            .Visible = True
        End With

        'xlWB.Close True
        'Set xlWB = Nothing
        'ApXL.Quit
        'Set ApXL = Nothing
    End If
End Function

You can use the function like this:

Private Sub AppendToExcel_Example()
    Call VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet", "C:TempTest.xlsx")
End Sub

Notice you are asked to define:

• What to Output? Table, Report, Query, or Form
• Object Name
• Output Sheet Name
• Output File Path and Name.

VBA Programming | Code Generator does work for you!

Export SQL Query to Excel

Instead you can export an SQL query to Excel using a similar function:

Public Function AppendToExcelSQLStatemet(strsql As String, strSheetName As String, strFileName As String)
    Dim strQueryName As String
    Dim ApXL As Excel.Application
    Dim xlWBk As Excel.Workbook
    Dim xlWSh As Excel.Worksheet
    Dim intCount As Integer
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlVAlignCenter = -4108
    Const xlContinuous As Long = 1
    Dim qdf As DAO.QueryDef
    Dim rst As DAO.Recordset
    
    strQueryName = "tmpQueryToExportToExcel"

    If ObjectExists("Query", strQueryName) Then
        CurrentDb.QueryDefs.Delete strQueryName
    End If
    Set qdf = CurrentDb.CreateQueryDef(strQueryName, strsql)
    Set rst = CurrentDb.OpenRecordset(strQueryName, dbOpenDynaset)

    If rst.RecordCount = 0 Then
        MsgBox "No records to be exported.", vbInformation, GetDBTitle
    Else
        On Error Resume Next
        Set ApXL = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set ApXL = CreateObject("Excel.Application")
        End If
        Err.Clear

        ApXL.Visible = False
        
        Set xlWBk = ApXL.Workbooks.Open(strFileName)
        Set xlWSh = xlWBk.Sheets.Add
        xlWSh.Name = Left(strSheetName, 31)

        
        xlWSh.Range("A1").Select
        Do Until intCount = rst.fields.Count
            ApXL.ActiveCell = rst.fields(intCount).Name
            ApXL.ActiveCell.Offset(0, 1).Select
            intCount = intCount + 1
        Loop

        rst.MoveFirst
        
        xlWSh.Range("A2").CopyFromRecordset rst

        With ApXL
            .Range("A1").Select
            .Range(.Selection, .Selection.End(xlToRight)).Select
            .Selection.Interior.Pattern = xlSolid
            .Selection.Interior.PatternColorIndex = xlAutomatic
            .Selection.Interior.TintAndShade = -0.25
            .Selection.Interior.PatternTintAndShade = 0
            .Selection.Borders.LineStyle = xlNone
            .Selection.AutoFilter
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit
            .Range("B2").Select
            .ActiveWindow.FreezePanes = True
            .ActiveSheet.Cells.Select
            .ActiveSheet.Cells.WrapText = False
            .ActiveSheet.Cells.EntireColumn.AutoFit
            xlWSh.Range("A1").Select
            .Visible = True
        End With


        'xlWB.Close True
        'Set xlWB = Nothing
        'ApXL.Quit
        'Set ApXL = Nothing
    End If
End Function

Called like this:

Private Sub AppendToExcelSQLStatemet_Example()
    Call VBA_Access_ImportExport.ExportToExcel("SELECT * FROM Table1", "VBASheet", "C:TempTest.xlsx")
End Sub

Where you are asked to input:

• SQL Query
• Output Sheet Name
• Output File Path and Name.

Function to Export to New Excel File

These functions allow you to export Access objects to a new Excel workbook. You might find them more useful than the simple single lines at the top of the document.

Public Function ExportToExcel(strObjectType As String, strObjectName As String, Optional strSheetName As String, Optional strFileName As String)

    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim intCount As Integer
    Const xlToRight As Long = -4161
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlContinuous As Long = 1

    On Error GoTo ExportToExcel_Err
    DoCmd.Hourglass True

    Select Case strObjectType

    Case "Table", "Query"
        Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset, dbSeeChanges)
    Case "Form"
        Set rst = Forms(strObjectName).RecordsetClone
    Case "Report"
        Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges)
    End Select

    If rst.RecordCount = 0 Then
        MsgBox "No records to be exported.", vbInformation, GetDBTitle
        DoCmd.Hourglass False
    Else
        On Error Resume Next
        Set ApXL = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set ApXL = CreateObject("Excel.Application")
        End If
        Err.Clear
        On Error GoTo ExportToExcel_Err

        Set xlWBk = ApXL.Workbooks.Add
        ApXL.Visible = False

        Set xlWSh = xlWBk.Worksheets("Sheet1")
        If Len(strSheetName) > 0 Then
            xlWSh.Name = Left(strSheetName, 31)
        End If

        xlWSh.Range("A1").Select
        Do Until intCount = rst.fields.Count
            ApXL.ActiveCell = rst.fields(intCount).Name
            ApXL.ActiveCell.Offset(0, 1).Select
            intCount = intCount + 1
        Loop

        rst.MoveFirst
        
        xlWSh.Range("A2").CopyFromRecordset rst

        With ApXL
            .Range("A1").Select
            .Range(.Selection, .Selection.End(xlToRight)).Select
            .Selection.Interior.Pattern = xlSolid
            .Selection.Interior.PatternColorIndex = xlAutomatic
            .Selection.Interior.TintAndShade = -0.25
            .Selection.Interior.PatternTintAndShade = 0
            .Selection.Borders.LineStyle = xlNone
            .Selection.AutoFilter
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit
            .Range("B2").Select
            .ActiveWindow.FreezePanes = True
            .ActiveSheet.Cells.Select
            .ActiveSheet.Cells.WrapText = False
            .ActiveSheet.Cells.EntireColumn.AutoFit
            xlWSh.Range("A1").Select
            .Visible = True
        End With

retry:
        If FileExists(strFileName) Then
            Kill strFileName
        End If
        If strFileName <> "" Then
            xlWBk.SaveAs strFileName, FileFormat:=56
        End If
        
        rst.Close
        Set rst = Nothing
        DoCmd.Hourglass False
    End If

ExportToExcel_Exit:
    DoCmd.Hourglass False
    Exit Function

ExportToExcel_Err:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    DoCmd.Hourglass False
    Resume ExportToExcel_Exit

End Function

The function can be called like this:

Private Sub ExportToExcel_Example()
 Call VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet")
End Sub

В этом руководстве будут рассмотрены способы импорта данных из Excel в таблицу Access и способы экспорта объектов Access (запросов, отчетов, таблиц или форм) в Excel.

Импортировать файл Excel в Access

Чтобы импортировать файл Excel в Access, используйте acImport вариант DoCmd.TransferSpreadsheet :

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, «Table1», «C:  Temp  Book1.xlsx», True

Или вы можете использовать DoCmd.TransferText чтобы импортировать файл CSV:

DoCmd.TransferText acLinkDelim,, «Таблица1», «C:  Temp  Book1.xlsx», True

Импортировать Excel в функцию доступа

Эту функцию можно использовать для импорта файла Excel или CSV в таблицу доступа:

Открытая функция ImportFile (имя файла как строка, HasFieldNames как логическое, TableName как строка) как логическое »Пример использования: call ImportFile (« Выбрать файл Excel »,« Файлы Excel »,« * .xlsx »,« C:  », True , True, "ExcelImportTest", True, True, false, True) При ошибке Перейти к err_handler If (Right (Filename, 3) = "xls") или ((Right (Filename, 4) = "xlsx")) Then DoCmd. TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If If (Right (Filename, 3) = "csv") Then DoCmd.TransferText acLinkDelim`` TableName, Filename, True End If Exit_Thing if: 'Очистить связанный в' Таблица Excel уже существует … и удалите ее, если это так. Если ObjectExists ("Table", TableName) = True Then DropTable (TableName) Установить colWorksheets = Nothing Функция выхода err_handler: If (Err.Number = 3086 или Err.Number = 3274 или Err. Number = 3073) And errCount <3 Then errCount = errCount + 1 ElseIf Err.Number = 3127 Then MsgBox "Поля на всех вкладках одинаковы. Убедитесь, что каждый лист имеет точные имена столбцов, если вы хотите импортировать несколько ", vbCritical," MultiSheets не идентичны "ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number &" - ​​"& Err.Description ImportFile = False GoTo Exit_Thing Resume End If End Function

Вы можете вызвать функцию так:

Private Sub ImportFile_Example () Вызов VBA_Access_ImportExport.ImportFile ("C:  Temp  Book1.xlsx", True, "Imported_Table_1") End Sub

Чтобы экспортировать объект Access в новый файл Excel, используйте DoCmd.OutputTo метод или DoCmd.TransferSpreadsheet метод:

Экспорт запроса в Excel

Эта строка кода VBA экспортирует запрос в Excel с помощью DoCmd.OutputTo:

DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c:  temp  ExportedQuery.xls"

Или вы можете использовать вместо этого метод DoCmd.TransferSpreadsheet:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, «Query1», «c:  temp  ExportedQuery.xls», True

Примечание: Этот код экспортирует в формат XLSX. Вместо этого вы можете обновить аргументы для экспорта в формат файла CSV или XLS (например, acFormatXLSX к acFormatXLS).

Экспорт отчета в Excel

Эта строка кода экспортирует отчет в Excel с помощью DoCmd.OutputTo:

DoCmd.OutputTo acOutputReport, «Report1», acFormatXLSX, «c:  temp  ExportedReport.xls»

Или вы можете использовать вместо этого метод DoCmd.TransferSpreadsheet:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, «Report1», «c:  temp  ExportedReport.xls», True

Экспорт таблицы в Excel

Эта строка кода экспортирует таблицу в Excel с помощью DoCmd.OutputTo:

DoCmd.OutputTo acOutputTable, «Table1», acFormatXLSX, «c:  temp  ExportedTable.xls»

Или вы можете использовать вместо этого метод DoCmd.TransferSpreadsheet:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, «Table1», «c:  temp  ExportedTable.xls», True

Экспорт формы в Excel

Эта строка кода экспортирует форму в Excel с помощью DoCmd.OutputTo:

DoCmd.OutputTo acOutputForm, «Form1», acFormatXLSX, «c:  temp  ExportedForm.xls»

Или вы можете использовать вместо этого метод DoCmd.TransferSpreadsheet:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, «Form1», «c:  temp  ExportedForm.xls», True

Экспорт в функции Excel

Эти однострочные команды отлично подходят для экспорта в новый файл Excel. Однако их нельзя будет экспортировать в существующую книгу. В следующем разделе мы представляем функции, которые позволяют вам добавить экспорт в существующий файл Excel.

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

Экспорт в существующий файл Excel

Приведенные выше примеры кода отлично подходят для экспорта объектов Access в новый файл Excel. Однако их нельзя будет экспортировать в существующую книгу.

Чтобы экспортировать объекты Access в существующую книгу Excel, мы создали следующую функцию:

Общедоступная функция AppendToExcel (strObjectType как строка, strObjectName как строка, strSheetName как строка, strFileName как строка) Dim rst as DAO.Recordset Dim ApXL As Excel.Application Dim xlWBk As Excel.Workbook Dim xlWSh Asim Integer. As Long = -4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 Выберите регистр strObjectType Case "Таблица", "Запрос" Установить rst = CurrentDb.OpenRecordset (strObjectName, dbOpenDynaset, dbOpenDynaset, dbOpenDynaset, dbeeSee "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) End Select If rst.RecordCount = 0 Then No records to be exported = 0 Then No records to be exported . ", vbInformation, GetDBTitle Остальное при ошибке Возобновить Далее Установить ApXL = GetObject (," Excel.Application ") Если Err.Number 0 Затем Установить ApXL = CreateObject (" Excel.Application ") Конец, если Err.Clear ApXL.Visible = False Установите xlWBk = ApXL.Workbooks.Open (strFil eName) Задайте xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Выберите "Выполнить до тех пор, пока intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount)". Назовите ApXL.ActiveCell.Offset (0, 1) .Select intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst With ApXL .Range ("A1"). Select .Range (.Selection, .Selection.End (xlToRight)). Выберите .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0. xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Выберите .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText.Cells. .EntireColumn.AutoFit xlWSh.Range ("A1"). Выберите .Visible = True End With 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function

Вы можете использовать эту функцию так:

Private Sub AppendToExcel_Example () Вызов VBA_Access_ImportExport.ExportToExcel («Таблица», «Таблица1», «VBASheet», «C:  Temp  Test.xlsx») End Sub

Обратите внимание, что вас просят определить:

• Что выводить? Таблица, отчет, запрос или форма
• Имя объекта
• Имя выходного листа
• Путь и имя выходного файла.

Экспорт SQL-запроса в Excel

Вместо этого вы можете экспортировать SQL-запрос в Excel, используя аналогичную функцию:

Открытая функция AppendToExcelSQLStatemet (strsql As String, strSheetName As String, strFileName As String) Dim strQueryName As String Dim ApXL As Excel.Application Dim xlWBk As Excel.Workbook Dim xlWSh As Excel.Worksheet Dim intCount10 As Integer Const x xlBottom As Long = -4107 Const xlVAlignCenter = -4108 Const xlContinuous As Long = 1 Dim qdf As DAO.QueryDef Dim rst As DAO.Recordset strQueryName = "tmpQueryToExportToExcel" IfldueryName.StrleteQeueryDueryName, strleteQext Конец Если Установить qdf = CurrentDb.CreateQueryDef (strQueryName, strsql) Установить rst = CurrentDb.OpenRecordset (strQueryName, dbOpenDynaset) Если rst.RecordCount = 0 Тогда MsgBox «Нет записей для экспорта. ApXL = GetObject (, "Excel.Application") Если Err.Number 0, тогда установите ApXL = CreateObject ("Excel.Application") End If Err.Clear ApXL.Visible = False Set xlWBk = ApXL.Workbooks.Open (strFileName) Set xlWSh = xlWBk.Sheet s.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Выберите "Do until intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset ( 0, 1) .Select intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst With ApXL .Range ("A1"). Select .Range (.Selection, .Selection.End (xlToRight) ) .Select .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Borders.LineStyle. … ("A1"). Выберите .Visible = True End With 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function

Вызывается так:

Private Sub AppendToExcelSQLStatemet_Example () Вызов VBA_Access_ImportExport.ExportToExcel («SELECT * FROM Table1», «VBASheet», «C:  Temp  Test.xlsx») End Sub

Где вас просят ввести:

• SQL-запрос
• Имя выходного листа
• Путь и имя выходного файла.

Функция экспорта в новый файл Excel

Эти функции позволяют экспортировать объекты Access в новую книгу Excel. Вы можете найти их более полезными, чем простые одиночные строки в верхней части документа.

Открытая функция ExportToExcel (strObjectType как строка, strObjectName как строка, необязательный strSheetName как строка, необязательный strFileName как строка) Dim rst as DAO.Recordset Dim ApXL As Object Dim xlWBk As Object Dim xlWSh As Object Dim intCount As Integer Const xlWSh As Object Dim intCount As Integer Const xlWSh As Object Dim intCount As Integer Const 4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 При ошибке GoTo ExportToExcel_Err DoCmd.Hourglass True Select Case strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenrRecordSet (strObjectType) , dbSeeChanges) Case "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) End Select If rst.Rec записи для экспорта. ", vbInformation, GetDBTitle DoCmd.Hourglass False Else При ошибке Возобновить Далее Установить ApXL = GetObject (," Excel.Application ") Если Err.Number 0 Затем Установить ApXL = CreateObject (" Excel.Application ") Конец Если Err. Очистить при ошибке Перейти к ExportToExcel_Err Установить xlWBk = ApXL.Workbooks.Add ApXL.Visible = False Установить xlWSh = xlWBk.Worksheets ("Sheet1") Если Len (strSheetName)> 0 Тогда xlWSh.Name = Left (31) Если xlWSh.Name = Left (31) If xlWSh EndheetName .Range ("A1"). Выберите "Сделать до" intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset (0, 1). Выберите intCount = intCount + 1 Loop rst. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst With ApXL .Range ("A1"). Select .Range (.Selection, .Selection.End (xlToRight)). Select .Selection.Interior.Pattern = xlSolid .Selection. Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Borders.LineStyle = xlNone .Selection.AutoFilter .Cells.EnutoColumn.AutoFilter .Cells.EnutoColumn.AutoFilter. B2 "). Выберите .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 "). Выберите .Visible = True End Wi th retry: If FileExists (strFileName) Then Kill strFileName End If If if strFileName "" Then xlWBk.SaveAs strFileName, FileFormat: = 56 End If rst.Close Set rst = Nothing DoCmd.Hourglass False End If ExportToExcel_Exit_Exit: DoC ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Resume ExportToExcel_Exit End Function

Функцию можно вызвать так:

Private Sub ExportToExcel_Example () Вызов VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet") End Sub

Была ли эта статья полезной?

Перейти к содержанию