Αυτό το σεμινάριο θα καλύψει τους τρόπους εισαγωγής δεδομένων από το Excel σε έναν πίνακα πρόσβασης και τρόπους εξαγωγής αντικειμένων της Access (Ερωτήματα, Αναφορές, Πίνακες ή Φόρμες) στο Excel.
Εισαγωγή αρχείου Excel σε πρόσβαση
Για να εισαγάγετε ένα αρχείο Excel στην Access, χρησιμοποιήστε το acImport επιλογή του Φύλλο DoCmd.TransferS spreadsheet :
DoCmd.TransferS spreadsheet acImport, acS spreadsheetTypeExcel12, "Table1", "C: \ Temp \ Book1.xlsx", True
Or μπορείτε να χρησιμοποιήσετε DoCmd.TransferText για εισαγωγή αρχείου CSV:
DoCmd.TransferText acLinkDelim,, "Table1", "C: \ Temp \ Book1.xlsx", True
Εισαγωγή του Excel για πρόσβαση στη λειτουργία
Αυτή η λειτουργία μπορεί να χρησιμοποιηθεί για την εισαγωγή αρχείου Excel ή αρχείου CSV σε πίνακα πρόσβασης:
Δημόσια συνάρτηση ImportFile (Όνομα αρχείου ως συμβολοσειρά, HasFieldNames As Boolean, TableName As String) Ως Boolean 'Παράδειγμα χρήσης: καλέστε ImportFile ("Επιλογή αρχείου Excel", "Αρχεία Excel", "*.xlsx", "C: \", True , True, "ExcelImportTest", True, True, false, True) On Error GoTo err_handler If (Δεξιά (Όνομα αρχείου, 3) = "xls") (((Δεξιά (Όνομα αρχείου, 4) = "xlsx")) Στη συνέχεια DoCmd. TransferS spreadsheet acImport, acS spreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If If (Δεξιά (Όνομα αρχείου, 3) = "csv") Στη συνέχεια DoCmd.TransferText acLinkDelim,, TableName, Filename, True End If Exit_Thing: 'Clean up' Έλεγχος Ο πίνακας Excel υπάρχει ήδη… και διαγράψτε τον αν υπάρχει Αν ObjectExists ("Table", TableName) = True Τότε DropTable (TableName) Set colWorksheets = Τίποτα δεν εξέρχεται από τη λειτουργία err_handler: If (Err.Number = 3086 Er Err.Number = 3274 Er Err. Αριθμός = 3073) Και errCount <3 Στη συνέχεια errCount = errCount + 1 ElseIf Err.Number = 3127 Στη συνέχεια MsgBox "Τα πεδία σε όλες τις καρτέλες είναι τα ίδια. Βεβαιωθείτε ότι κάθε φύλλο έχει τα ακριβή ονόματα στηλών εάν επιθυμείτε να εισαγάγετε πολλαπλά ", vbCritical," Πολλά φύλλα δεν είναι πανομοιότυπα "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 () Call VBA_Access_ImportExport.ImportFile ("C: \ Temp \ Book1.xlsx", True, "Imported_Table_1") End Sub
Πρόσβαση στο VBA Export σε νέο αρχείο Excel
Για εξαγωγή αντικειμένου της Access σε νέο αρχείο Excel, χρησιμοποιήστε το DoCmd.OutputTo μέθοδο ή το Μέθοδος DoCmd.TransferS spreadsheet:
Εξαγωγή ερωτήματος στο Excel
Αυτή η γραμμή κώδικα VBA θα εξάγει ένα ερώτημα στο Excel χρησιμοποιώντας το DoCmd.OutputTo:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c: \ temp \ ExportedQuery.xls"
Εναλλακτικά, μπορείτε να χρησιμοποιήσετε τη μέθοδο DoCmd.TransferS spreadsheet:
DoCmd.TransferS spreadsheet acExport, acS spreadsheetTypeExcel8, "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.TransferS spreadsheet:
DoCmd.TransferS spreadsheet acExport, acS spreadsheetTypeExcel8, "Report1", "c: \ temp \ ExportedReport.xls", True
Εξαγωγή πίνακα στο Excel
Αυτή η γραμμή κώδικα θα εξάγει έναν πίνακα στο Excel χρησιμοποιώντας το DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c: \ temp \ ExportedTable.xls"
Εναλλακτικά, μπορείτε να χρησιμοποιήσετε τη μέθοδο DoCmd.TransferS spreadsheet:
DoCmd.TransferS spreadsheet acExport, acS spreadsheetTypeExcel8, "Table1", "c: \ temp \ ExportedTable.xls", True
Εξαγωγή φόρμας στο Excel
Αυτή η γραμμή κώδικα θα εξάγει μια φόρμα στο Excel χρησιμοποιώντας το DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c: \ temp \ ExportedForm.xls"
Εναλλακτικά, μπορείτε να χρησιμοποιήσετε τη μέθοδο DoCmd.TransferS spreadsheet:
DoCmd.TransferS spreadsheet acExport, acS spreadsheetTypeExcel8, "Form1", "c: \ temp \ ExportedForm.xls", True
Εξαγωγή σε λειτουργίες Excel
Αυτές οι εντολές μιας γραμμής λειτουργούν εξαιρετικά για εξαγωγή σε νέο αρχείο Excel. Ωστόσο, δεν θα μπορούν να εξάγουν σε υπάρχον βιβλίο εργασίας. Στην παρακάτω ενότητα εισάγουμε συναρτήσεις που σας επιτρέπουν να προσθέσετε την εξαγωγή σας σε ένα υπάρχον αρχείο Excel.
Κάτω από αυτό, έχουμε συμπεριλάβει μερικές πρόσθετες λειτουργίες για εξαγωγή σε νέα αρχεία Excel, συμπεριλαμβανομένου του χειρισμού σφαλμάτων και άλλα.
Εξαγωγή σε υπάρχον αρχείο Excel
Τα παραπάνω παραδείγματα κώδικα λειτουργούν εξαιρετικά για την εξαγωγή αντικειμένων της Access σε ένα νέο αρχείο Excel. Ωστόσο, δεν θα μπορούν να εξάγουν σε υπάρχον βιβλίο εργασίας.
Για την εξαγωγή αντικειμένων της Access σε ένα υπάρχον βιβλίο εργασίας του Excel δημιουργήσαμε την ακόλουθη συνάρτηση:
Δημόσια λειτουργία 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 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, dbOpenDease, dbOpenDe "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) Τέλος Επιλέξτε If rst.RecordCount = 0 Στη συνέχεια Ms . ", 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 Ορίστε xlWBk = ApXL.Workbooks.Open (strFil eName) Ορίστε xlWSh = xlWBk.Sheets.Add xlWSh.Name = Αριστερά (strSheetName, 31) xlWSh.Range ("A1"). Επιλέξτε Do Until intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) Όνομα ApXL.ActiveCell.Offset (0, 1) .Επιλέξτε intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset πρώτα Με ApXL .Range ("A1"). Επιλέξτε .Range (.Επιλογή, .Selection.End (xlToRight)). Επιλέξτε .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShaine =Style = 0 xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Select .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.Well.Cells.Well .EntireColumn.AutoFit xlWSh.Range ("A1"). Επιλέξτε .Visible = True End With 'xlWB.Close True' Set xlWB = τίποτα 'ApXL.Quit' Set ApXL = Τίποτα δεν τελειώνει εάν τελειώσει η λειτουργία
Μπορείτε να χρησιμοποιήσετε τη συνάρτηση ως εξής:
Private Sub AppendToExcel_Example () Καλέστε VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "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 xCW4 xlBottom As Long = -4107 Const xlVAlignCenter = -4108 Const xlΣυνέχεια Όσο = 1 Dim qdf As DAO.QueryDef Dim rst Asστερο DAO.Recordset strQueryName = "tmpQueryToExportToExcel" If ObjectEmequery, Query Τέλος Εάν οριστεί qdf = CurrentDb.CreateQueryDef (strQueryName, strsql) Ορίστε rst = CurrentDb.OpenRecordset (strQueryName, dbOpenDynaset) If rst.RecordCount = 0 Τότε MsgBox "Δεν υπάρχουν εγγραφές προς εξαγωγή." ApXL = GetObject (, "Excel.Application") If Err.Number 0 Στη συνέχεια ορίστε ApXL = CreateObject ("Excel.Application") End If Err.Clear ApXL.Visible = False Set xlWBk = ApXL.Workbooks.Open (strFileName) Set xlWSh = xlWBk.Φύλλο s.Add xlWSh.Name = Αριστερά (strSheetName, 31) xlWSh.Range ("A1"). Επιλέξτε Do Until 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) ) .Επιλογή .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Borders.LineStyle = .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Επιλέξτε .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheetColsCels.Ell.Ell.Cells.Ell.Ell.Cells.Ell.Cells.Ell. ("A1"). Επιλέξτε .Visible = True End With 'xlWB.Close True' Set xlWB = τίποτα 'ApXL.Quit' Set ApXL = Τίποτα δεν τελειώνει εάν τελειώσει η λειτουργία
Ονομάζεται έτσι:
Private Sub AppendToExcelSQLStatemet_Example () Καλέστε VBA_Access_ImportExport.ExportToExcel ("SELECT * FROM Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Όπου σας ζητείται να εισαγάγετε:
- Ερώτημα SQL
- Όνομα φύλλου εξόδου
- Διαδρομή και όνομα αρχείου εξόδου.
Λειτουργία εξαγωγής σε νέο αρχείο Excel
Αυτές οι λειτουργίες σάς επιτρέπουν να εξάγετε αντικείμενα της Access σε ένα νέο βιβλίο εργασίας του Excel. Μπορεί να τα βρείτε πιο χρήσιμα από τις απλές μεμονωμένες γραμμές στο επάνω μέρος του εγγράφου.
Δημόσια Λειτουργία 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 Integ 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 = CurrentDbenOname, OpenRject , dbSeeChanges) Περίπτωση "Φόρμα" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanoxRest εγγραφές προς εξαγωγή. ", vbInformation, GetDBTitle DoCmd.Hourglass False Else On Error Συνέχιση Επόμενο Σετ ApXL = GetObject (," Excel.Application ") If Err.Number 0 Στη συνέχεια, ορίστε ApXL = CreateObject (" Excel.Application ") Τέλος Αν Πλανώμαι. Clear On Error GoTo ExportToExcel_Err Set xlWBk = ApXL.Workbooks.Add ApXL.Visible = False Set xlWSh = xlWBk.Worksheets ("Sheet1") If Len (strSheetName)> 0 Στη συνέχεια xlWSh.Name = Left x .Range ("A1"). Επιλέξτε Do Until intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset (0, 1) .Επιλέξτε intCount = intCount + 1 Loop πρώτα. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset πρώτα Με ApXL .Range ("A1"). Επιλέξτε .Range (.Selection, .Selection.End (xlToRight)). Επιλέξτε .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.EntireColumn.EntireColumn B2 "). Επιλέξτε .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 "). Επιλέξτε .Visible = True th ξαναδοκίμασε: 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: DoCm ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Lourglass False Resume ExportToExcel_Exit End Function
Η συνάρτηση μπορεί να ονομαστεί ως εξής:
Private Sub ExportToExcel_Example () Call VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet") End Sub
