Acest tutorial va acoperi modalitățile de importare a datelor din Excel într-un tabel de acces și modalitățile de a exporta obiecte Access (interogări, rapoarte, tabele sau formulare) în Excel.
Importați fișierul Excel în acces
Pentru a importa un fișier Excel în Access, utilizați fișierul acImport opțiunea de DoCmd.TransferSpreadsheet :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C: \ Temp \ Book1.xlsx", True
Sau puteți folosi DoCmd.TransferText pentru a importa un fișier CSV:
DoCmd.TransferText acLinkDelim,, "Table1", "C: \ Temp \ Book1.xlsx", True
Importați Excel în funcția de acces
Această funcție poate fi utilizată pentru a importa un fișier Excel sau un fișier CSV într-un tabel de acces:
Funcție publică ImportFile (numele de fișier ca șir, HasFieldNames ca Boolean, TableName ca șir) Ca Boolean 'Exemplu de utilizare: apelați ImportFile ("Selectați un fișier Excel", "Fișiere Excel", "* .xlsx", "C: \", True , Adevărat, "ExcelImportTest", Adevărat, Adevărat, fals, Adevărat) La eroare Du-te la er_handler Dacă (Dreapta (Numele fișierului, 3) = "xls") Sau ((Dreapta (Numele fișierului, 4) = "xlsx")) Apoi 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' Tabelul Excel există deja … și ștergeți-l dacă da. Dacă ObjectExists ("Table", TableName) = True, apoi DropTable (TableName) Set colWorksheets = Nothing Exit Function err_handler: If (Err.Number = 3086 Sau Err.Number = 3274 Sau Err. Number = 3073) Și errCount <3 Apoi errCount = errCount + 1 ElseIf Err.Number = 3127 Apoi MsgBox "Câmpurile din toate filele sunt aceleași. Vă rugăm să vă asigurați că fiecare foaie are numele coloanei exacte dacă doriți să importați mulitple ", vbCritical," MultiSheets not identic "ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number &" - "& Err.Description ImportFile = False GoTo Exit_Thing Reîncepeți dacă funcția End
Puteți apela funcția astfel:
Private Sub ImportFile_Example () Apelați VBA_Access_ImportExport.ImportFile („C: \ Temp \ Book1.xlsx”, adevărat, „Imported_Table_1”) Terminați sub
Accesați VBA Export în noul fișier Excel
Pentru a exporta un obiect Access într-un fișier Excel nou, utilizați DoCmd.OutputTo metoda sau Metoda DoCmd.TransferSpreadsheet:
Exportați interogarea în Excel
Această linie de cod VBA va exporta o interogare în Excel folosind DoCmd.OutputTo:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c: \ temp \ ExportedQuery.xls"
Sau puteți utiliza în schimb metoda DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c: \ temp \ ExportedQuery.xls", True
Notă: Acest cod exportă în format XLSX. În schimb, puteți actualiza argumentele pentru a le exporta într-un format de fișier CSV sau XLS (de ex. acFormatXLSX la acFormatXLS).
Exportați raportul în Excel
Această linie de cod va exporta un raport în Excel folosind DoCmd.OutputTo:
DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c: \ temp \ ExportedReport.xls"
Sau puteți utiliza în schimb metoda DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c: \ temp \ ExportedReport.xls", True
Exportați tabelul în Excel
Această linie de cod va exporta un tabel în Excel folosind DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c: \ temp \ ExportedTable.xls"
Sau puteți utiliza în schimb metoda DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c: \ temp \ ExportedTable.xls", True
Exportați formularul în Excel
Această linie de cod va exporta un formular în Excel folosind DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c: \ temp \ ExportedForm.xls"
Sau puteți utiliza în schimb metoda DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c: \ temp \ ExportedForm.xls", True
Exportați în funcții Excel
Aceste comenzi cu o singură linie funcționează excelent pentru a le exporta într-un nou fișier Excel. Cu toate acestea, nu vor putea exporta într-un registru de lucru existent. În secțiunea de mai jos introducem funcții care vă permit să adăugați exportul la un fișier Excel existent.
Mai jos, am inclus câteva funcții suplimentare pentru a le exporta în fișiere Excel noi, inclusiv gestionarea erorilor și multe altele.
Exportați în fișierul Excel existent
Exemplele de cod de mai sus funcționează excelent pentru a exporta obiecte Access într-un nou fișier Excel. Cu toate acestea, nu vor putea exporta într-un registru de lucru existent.
Pentru a exporta obiecte Access într-un registru de lucru Excel existent, am creat următoarea funcție:
Function Public 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.Workso Dimight IntCount 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, dbSee "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 . ", vbInformation, GetDBTitle Else On Error Resume Next Set ApXL = GetObject (," Excel.Application ") If Err.Number 0 Apoi Set ApXL = CreateObject (" Excel.Application ") End If Err.Clear ApXL.Visible = False Setați xlWBk = ApXL.Workbooks.Open (strFil eName) Setați xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Selectați Do Until IntCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Denumiți ApXL.ActiveCell.Offset (0, 1). Selectați intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst With ApXL .Range ("A1"). Selectați .Range (.Selection, .Selection.End (xlToRight)). Selectați. xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Selectați .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False. .EntireColumn.AutoFit xlWSh.Range ("A1"). Selectați .Visibil = Adevărat sfârșit cu 'xlWB.Închidere Adevărat' Set xlWB = Nimic 'ApXL.Quit' Set ApXL = Nimic nu se încheie dacă funcția de încheiere
Puteți utiliza funcția astfel:
Private Sub AppendToExcel_Example () Apelați VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Observați că vi se cere să definiți:
- Ce să ieșiți? Tabel, raport, interogare sau formular
- Numele obiectului
- Nume foaie de ieșire
- Calea și numele fișierului de ieșire.
Exportați interogarea SQL în Excel
În schimb, puteți exporta o interogare SQL în Excel utilizând o funcție similară:
Function Public 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 Long xlCent 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", strQueryDQ 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, Next Reset, GetDBT ApXL = GetObject (, "Excel.Application") Dacă Err.Number 0 Apoi Set ApXL = CreateObject ("Excel.Application") Sfârșit Dacă 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"). Selectați Do Until IntCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Nume ApXL.ActiveCell.Offset ( 0, 1). Selectați intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst With ApXL .Range ("A1"). Select .Range (.Selection, .Selection.End (xlToRight) ) .Selectați. .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Selectați .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn. ("A1"). Selectați .Vizibil = Adevărat sfârșit cu 'xlWB.Închide Adevărat' Set xlWB = Nimic 'ApXL.Quit' Set ApXL = Nimic nu se încheie dacă funcția de încheiere
Numit așa:
Private Sub AppendToExcelSQLStatemet_Example () Apelați VBA_Access_ImportExport.ExportToExcel ("SELECT * FROM Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Unde vi se cere să introduceți:
- Interogare SQL
- Nume foaie de ieșire
- Calea și numele fișierului de ieșire.
Funcție de exportat în fișier Excel nou
Aceste funcții vă permit să exportați obiecte Access într-un nou registru Excel. S-ar putea să le găsiți mai utile decât simplele linii simple din partea de sus a documentului.
Funcția publică 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 xlTo 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.OpenRecordet (dB , dbSeeChanges) Case "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) End Select If rst.RecordCount înregistrări care urmează să fie exportate. ", 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 Eror. 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 .Range ("A1"). Selectați Do Until intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Nume ApXL.ActiveCell.Offset (0, 1). Selectați intCount = intCount + 1 Loop rst. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst With ApXL .Range ("A1"). Select .Range (.Selection, .Selection.End (xlToRight)). Selectați .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. B2 "). Selectați .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 "). Selectați .Visible = True End Wi reîncercați: Dacă FileExists (strFileName), apoi ucideți strFileName End If If strFileName "" Atunci xlWBk.SaveAs strFileName, FileFormat: = 56 End If rst.Close Set rst = Nothing DoCmd.Hourglass False End If ExportToExcel_Exit: DoCmdse ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Resume ExportToExcel_Exit End Function
Funcția poate fi numită astfel:
Private Sub ExportToExcel_Example () Apelați VBA_Access_ImportExport.ExportToExcel („Tabel”, „Tabel1”, „Foaie VBAS”) Încheiere sub
