Truy cập VBA - Nhập / Xuất Excel - Truy vấn, Báo cáo, Bảng và Biểu mẫu

Hướng dẫn này sẽ trình bày các cách nhập dữ liệu từ Excel vào Bảng Access và các cách xuất các đối tượng Access (Truy vấn, Báo cáo, Bảng hoặc Biểu mẫu) sang Excel.

Nhập tệp Excel vào quyền truy cập

Để nhập tệp Excel vào Access, hãy sử dụng acImport tùy chọn của DoCmd.TransferS Spreadsheet :

DoCmd.

Hoặc bạn có thể sử dụng DoCmd.TransferText để nhập tệp CSV:

DoCmd.TransferText acLinkDelim, "Table1", "C: \ Temp \ Book1.xlsx", True

Nhập Excel vào Hàm Access

Hàm này có thể được sử dụng để nhập tệp Excel hoặc tệp CSV vào Bảng Access:

Hàm công khai ImportFile (Tên tệp là chuỗi, HasFieldNames là Boolean, TableName dưới dạng chuỗi) Như Boolean 'Ví dụ sử dụng: gọi ImportFile ("Chọn tệp Excel", "Tệp Excel", "* .xlsx", "C: \", True , Đúng, "ExcelImportTest", Đúng, Đúng, sai, Đúng) Khi Lỗi GoTo err_handler If (Right (Filename, 3) = "xls") Or ((Right (Filename, 4) = "xlsx")) Then DoCmd. TransferS Spreadsheet acImport, acSosystemsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If (Right (Filename, 3) = "csv") Then DoCmd.TransferText acLinkDelim, TableName, Filename, True End If Exit_Thing: 'Dọn dẹp' Kiểm tra xem chúng ta đã liên kết trong chưa Bảng Excel đã tồn tại… và hãy xóa nó nếu vậy Nếu ObjectExists ("Table", TableName) = True Then DropTable (TableName) Đặt colWorksheets = Nothing Exit Function err_handler: If (Err.Number = 3086 Hoặc Err.Number = 3274 Hoặc Err. Number = 3073) And errCount <3 Then errCount = errCount + 1 ElseIf Err.Number = 3127 Then MsgBox "Các trường trong tất cả các tab đều giống nhau. Vui lòng đảm bảo rằng mỗi trang tính có tên cột chính xác nếu bạn muốn nhập nhiều ", vbCritical," MultiSheets không giống nhau "ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number &" - ​​"& Err.Description ImportFile = False GoTo Exit_Thing Resume End If End Function

Bạn có thể gọi hàm như sau:

Private Sub ImportFile_Example () Gọi VBA_Access_ImportExport.ImportFile ("C: \ Temp \ Book1.xlsx", True, "Imported_Table_1") End Sub

Truy cập VBA Xuất sang tệp Excel mới

Để xuất một đối tượng Access sang một tệp Excel mới, hãy sử dụng DoCmd.OutputTo phương pháp hoặc Phương thức DoCmd.TransferS Spreadsheet:

Xuất truy vấn sang Excel

Dòng mã VBA này sẽ xuất một Truy vấn sang Excel bằng DoCmd.OutputTo:

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

Hoặc bạn có thể sử dụng phương thức DoCmd.TransferS Spreadsheet để thay thế:

DoCmd.

Ghi chú: Mã này xuất sang định dạng XLSX. Thay vào đó, bạn có thể cập nhật các đối số để xuất sang định dạng tệp CSV hoặc XLS thay thế (ví dụ: acFormatXLSX đến acFormatXLS).

Xuất báo cáo sang Excel

Dòng mã này sẽ xuất Báo cáo sang Excel bằng DoCmd.OutputTo:

DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c: \ temp \ ExportedReport.xls"

Hoặc bạn có thể sử dụng phương thức DoCmd.TransferS Spreadsheet để thay thế:

DoCmd.

Xuất bảng sang Excel

Dòng mã này sẽ xuất một Bảng sang Excel bằng DoCmd.OutputTo:

DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c: \ temp \ ExportedTable.xls"

Hoặc bạn có thể sử dụng phương thức DoCmd.TransferS Spreadsheet để thay thế:

DoCmd.

Xuất biểu mẫu sang Excel

Dòng mã này sẽ xuất một Biểu mẫu sang Excel bằng DoCmd.OutputTo:

DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c: \ temp \ ExportedForm.xls"

Hoặc bạn có thể sử dụng phương thức DoCmd.TransferS Spreadsheet để thay thế:

DoCmd.

Xuất sang các Hàm Excel

Các lệnh một dòng này hoạt động tuyệt vời để xuất sang tệp Excel mới. Tuy nhiên, họ sẽ không thể xuất vào sổ làm việc hiện có. Trong phần dưới đây, chúng tôi giới thiệu các hàm cho phép bạn nối bản xuất của mình vào tệp Excel hiện có.

Bên dưới đó, chúng tôi đã bao gồm một số chức năng bổ sung để xuất sang tệp Excel mới, bao gồm xử lý lỗi và hơn thế nữa.

Xuất sang tệp Excel hiện có

Các ví dụ mã trên hoạt động tuyệt vời để xuất các đối tượng Access sang một tệp Excel mới. Tuy nhiên, họ sẽ không thể xuất vào sổ làm việc hiện có.

Để xuất các đối tượng Access sang sổ làm việc Excel hiện có, chúng tôi đã tạo hàm sau:

Public Function AppendToExcel (strObjectType As String, strObjectName As String, strSheetName As String, strFileName As String) Dim đầu tiên As DAO.Recordset Dim ApXL As Excel. 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, dbOngespenDynaset, dbSee) "Biểu mẫu" Đặt rst = Biểu mẫu (strObjectName) .RecordsetClone Trường hợp "Báo cáo" Đặt rst = CurrentDb.OpenRecordset (Báo cáo (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) Kết thúc Chọn Nếu rst.RecordCount = 0 Sau đó MsgBox được xuất . ", vbInformation, GetDBTitle Khác khi có lỗi Tiếp tục lại Tiếp theo Đặt ApXL = GetObject (," Excel.Application ") Nếu Err.Number 0 Sau đó Đặt ApXL = CreateObject (" Excel.Application ") Kết thúc Nếu Err.Clear ApXL.Vible = False Đặt xlWBk = ApXL.Workbooks.Open (strFil eName) Đặt xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Chọn Do Until intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Đặt tên ApXL.ActiveCell.Offset (0, 1). Chọn intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset đầu tiên Với ApXL .Range ("A1"). Chọn .Range (.Selection, .Selection.End (xlToRight)). Chọn .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0,25 .Selection.Interior.PatternTintAndSelection = 0. xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Chọn .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells. .EntireColumn.AutoFit xlWSh.Range ("A1"). Chọn .Vible = True End With 'xlWB.Close True' Đặt xlWB = Nothing 'ApXL.Quit' Đặt ApXL = Không có gì Kết thúc Nếu Kết thúc Hàm

Bạn có thể sử dụng chức năng như sau:

Private Sub AppendToExcel_Example () Gọi VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub

Lưu ý rằng bạn được yêu cầu xác định:

• Đầu ra là gì? Bảng, Báo cáo, Truy vấn hoặc Biểu mẫu
• Tên của môn học
• Tên trang đầu ra
• Đường dẫn và tên tệp đầu ra.

Xuất truy vấn SQL sang Excel

Thay vào đó, bạn có thể xuất truy vấn SQL sang Excel bằng một hàm tương tự:

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 dài xlCenter As xlBottom As Long = -4107 Const xlVAlignCenter = -4108 Const xlContinuous As Long = 1 Dim qdf As DAO.QueryDef Dim đầu tiên As DAO. Kết thúc Nếu Đặt qdf = CurrentDb.CreateQueryDef (strQueryName, strsql) Đặt rst = CurrentDb.OpenRecordset (strQueryName, dbOpenDynaset) Nếu rst.RecordCount = 0 Sau đó MsgBox "Không có bản ghi nào được xuất.", VbInformation, GetDBTitle Tiếp theo Tập hợp khác ApXL = GetObject (, "Excel.Application") If Err.Number 0 Then Set ApXL = CreateObject ("Excel.Application") End If Err.Clear ApXL.Vible = False Set xlWBk = ApXL.Workbooks.Open (strFileName) Set xlWSh = xlWBk.Sheet s.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Chọn Do Until intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset ( 0, 1). Chọn intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset Đầu tiên Với ApXL .Range ("A1"). Chọn .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.LutoF. .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Chọn .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit x. ("A1"). Chọn .Vible = True End With 'xlWB.Close True' Đặt xlWB = Không có gì 'ApXL.Quit' Đặt ApXL = Không có gì Kết thúc Nếu Kết thúc Hàm

Được gọi như thế này:

Private Sub AppendToExcelSQLStatemet_Example () Gọi VBA_Access_ImportExport.ExportToExcel ("SELECT * FROM Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub

Nơi bạn được yêu cầu nhập:

• Truy vấn SQL
• Tên trang đầu ra
• Đường dẫn và tên tệp đầu ra.

Hàm xuất sang tệp Excel mới

Các hàm này cho phép bạn xuất các đối tượng Access sang một sổ làm việc Excel mới. Bạn có thể thấy chúng hữu ích hơn những dòng đơn giản ở đầu tài liệu.

Chức năng công khai ExportToExcel (strObjectType As String, strObjectName As String, strSheetName As String tùy chọn, strFileName As String tùy chọn) Dim đầu tiên As DAO.Recordset Dim ApXL As Object Dim xlWBk As Object Dim xlWSh As Object Dim intCount As Integer Const xlTo 4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 On Error GoTo ExportToExcel_Err DoCmd. , dbSeeChanges) Trường hợp "Biểu mẫu" Đặt rst = Biểu mẫu (strObjectName) .RecordsetClone Trường hợp "Báo cáo" Đặt rst = CurrentDb.OpenRecordset (Báo cáo (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) Kết thúc Chọn Nếu rst. bản ghi sẽ được xuất. ", vbInformation, GetDBTitle DoCmd.Hourglass False Khác Khi Tiếp tục Lỗi Tiếp tục Đặt ApXL = GetObject (," Excel.Application ") Nếu Err.Number 0 Sau đó Đặt ApXL = CreateObject (" Excel.Application ") Kết thúc Nếu Ờ. Xóa khi lỗi GoTo ExportToExcel_Err Đặt xlWBk = ApXL.Workbooks.Add ApXL.Vible = False Set xlWSh = xlWBk.Worksheets ("Sheet1") Nếu Len (strSheetName)> 0 Sau đó xlWSh.Name = Left (strSheetName, 31) Kết thúc Nếu xlWSh .Range ("A1"). Chọn Do Until intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset (0, 1). Chọn intCount = intCount + 1 Loop đầu tiên. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst Với ​​ApXL .Range ("A1"). Chọn .Range (.Selection, .Selection.End (xlToRight)). Chọn .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 .Rows.EntireColumn.AutoFit .Range B2 "). Chọn .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 "). Chọn .Vible = True End Wi Th thử lại: 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 ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Resume ExportToExcel_Exit Chức năng kết thúc

Hàm có thể được gọi như thế này:

Private Sub ExportToExcel_Example () Gọi VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet") End Sub