Questo tutorial tratterà i modi per importare i dati da Excel in una tabella di Access e i modi per esportare gli oggetti di Access (query, report, tabelle o moduli) in Excel.
Importa file Excel in Access
Per importare un file Excel in Access, utilizzare il pulsante acImport opzione di DoCmd.TransferFoglio di calcolo :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C:\Temp\Book1.xlsx", True
Oppure puoi usare DoCmd.TransferText per importare un file CSV:
DoCmd.TransferText acLinkDelim, , "Table1", "C:\Temp\Book1.xlsx", True
Importa Excel per accedere alla funzione
Questa funzione può essere utilizzata per importare un file Excel o CSV in una tabella di accesso:
Public Function ImportFile(Filename As String, HasFieldNames As Boolean, TableName As String) As Boolean ' Esempio di utilizzo: call ImportFile ("Seleziona un file Excel", "File Excel", "*.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 (Right(Filename, 3) = "csv") Then DoCmd.TransferText acLinkDelim, , TableName, Filename, True End If Exit_Thing: 'Clean up' Controlla se il nostro link è La tabella Excel esiste già… ed eliminala in caso affermativo If ObjectExists("Table", TableName) = True Then DropTable (TableName) Imposta 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 "I campi in tutte le schede sono uguali. Assicurati che ogni foglio ha i nomi esatti delle colonne se si desidera importare più", vbCritical, "MultiSheets non identici" ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number & " - " & Err.Description ImportFile = False GoTo Exit_Thing Resume End If End Function
Puoi chiamare la funzione in questo modo:
Private Sub ImportFile_Example() Call VBA_Access_ImportExport.ImportFile("C:\Temp\Book1.xlsx", True, "Imported_Table_1") End Sub
Accedi all'esportazione VBA in un nuovo file Excel
Per esportare un oggetto di Access in un nuovo file Excel, utilizzare il pulsante DoCmd.OutputTo metodo o il Metodo DoCmd.TransferSpreadsheet:
Esporta query in Excel
Questa riga di codice VBA esporterà una query in Excel utilizzando DoCmd.OutputTo:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c:\temp\ExportedQuery.xls"
Oppure puoi utilizzare invece il metodo DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c:\temp\ExportedQuery.xls", True
Nota: Questo codice esporta in formato XLSX. Invece puoi aggiornare gli argomenti per esportare in un formato di file CSV o XLS (es. acFormatXLSX a acFormatXLS).
Esporta report in Excel
Questa riga di codice esporterà un report in Excel utilizzando DoCmd.OutputTo:
DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c:\temp\ExportedReport.xls"
Oppure puoi utilizzare invece il metodo DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c:\temp\ExportedReport.xls", True
Esporta tabella in Excel
Questa riga di codice esporterà una tabella in Excel utilizzando DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c:\temp\ExportedTable.xls"
Oppure puoi utilizzare invece il metodo DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c:\temp\ExportedTable.xls", True
Esporta modulo in Excel
Questa riga di codice esporterà un modulo in Excel utilizzando DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c:\temp\ExportedForm.xls"
Oppure puoi usare invece il metodo DoCmd.TransferSpreadsheet:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c:\temp\ExportedForm.xls", True
Funzioni di esportazione in Excel
Questi comandi di una riga funzionano benissimo per esportare in un nuovo file Excel. Tuttavia, non saranno in grado di esportare in una cartella di lavoro esistente. Nella sezione seguente introduciamo le funzioni che ti consentono di aggiungere la tua esportazione a un file Excel esistente.
Di seguito, abbiamo incluso alcune funzioni aggiuntive da esportare in nuovi file Excel, inclusa la gestione degli errori e altro ancora.
Esporta in un file Excel esistente
Gli esempi di codice sopra funzionano alla grande per esportare oggetti di Access in un nuovo file Excel. Tuttavia, non saranno in grado di esportare in una cartella di lavoro esistente.
Per esportare oggetti di Access in una cartella di lavoro Excel esistente abbiamo creato la seguente funzione:
Funzione pubblica 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 xlTo As Long = -4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 Seleziona 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 "Nessun record da esportare .", 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 Imposta xlWBk = ApXL.Workbooks.Open(strFil eName) Imposta xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left(strSheetName, 31) xlWSh.Range("A1").Seleziona Esegui fino a intCount = rst.fields.Count ApXL.ActiveCell = rst.fields(intCount). Nome 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.Style =Borders. xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range("B2").Select .ActiveWindow.FreezePanes = Vero .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = Falso.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
Puoi usare la funzione in questo modo:
Private Sub AppendToExcel_Example() Call VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet", "C:\Temp\Test.xlsx") End Sub
Nota che ti viene chiesto di definire:
- Cosa produrre? Tabella, report, query o modulo
- Nome oggetto
- Nome foglio di output
- Percorso e nome del file di output.
Esporta query SQL in Excel
Invece puoi esportare una query SQL in Excel usando una funzione simile:
Funzione pubblica 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 Const As Long = -4108 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.QueryDef str. End If Set qdf = CurrentDb.CreateQueryDef(strQueryName, strsql) Set rst = CurrentDb.OpenRecordset(strQueryName, dbOpenDynaset) If rst.RecordCount = 0 Then MsgBox "Nessun record da esportare.", 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.Sheet s.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 = xlNonelter .Selection.Cells .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range("B2").Select .ActiveWindow.FreezePanes = Vero .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = Falso .ActiveSheet.Cells.EntireColumn.WS ("A1").Select .Visible = True End With 'xlWB.Close True 'Set xlWB = Nothing 'ApXL.Quit 'Set ApXL = Nothing End If End Function
Chiamato così:
Private Sub AppendToExcelSQLStatemet_Example() Call VBA_Access_ImportExport.ExportToExcel("SELECT * FROM Table1", "VBASheet", "C:\Temp\Test.xlsx") End Sub
Dove ti viene chiesto di inserire:
- Query SQL
- Nome foglio di output
- Percorso e nome del file di output.
Funzione da esportare in un nuovo file Excel
Queste funzioni consentono di esportare oggetti di Access in una nuova cartella di lavoro di Excel. Potresti trovarli più utili delle semplici righe singole nella parte superiore del documento.
Funzione pubblica 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 In caso di errore GoTo ExportToExcel_Err DoCmd.Hourglass True Select Case strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset , dbSeeChanges) Case "Form" Imposta rst = Forms(strObjectName).RecordsetClone Case "Report" Imposta rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges) End Select If rst.RecordCount = 0 Then MsgBox " record da esportare.", 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. Cancella in caso di errore 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").Seleziona Esegui fino a intCount = rst.fields.Count ApXL.ActiveCell = rst.fields(intCount).Name ApXL.ActiveCell.Offset(0, 1).Seleziona 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.Auto.EntireRowells B2").Select .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range("A1").Select .Visible = True End Wi th 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 Funzione False ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Resume ExportToExcel_Exit End Function
La funzione può essere chiamata in questo modo:
Private Sub ExportToExcel_Example() Chiama VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet") End Sub
