See õpetus hõlmab viise andmete importimiseks Excelist Accessi tabelisse ja Accessi objektide (päringud, aruanded, tabelid või vormid) Excelisse eksportimise viise.
Importige Exceli fail juurdepääsuks
Exceli faili Accessi importimiseks kasutage acImport võimalus DoCmd.TransferSheetsheet :
DoCmd.TransferSheetsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C: \ Temp \ Book1.xlsx", True
Või võite kasutada DoCmd.TransferText CSV -faili importimiseks tehke järgmist.
DoCmd.TransferText acLinkDelim, "Table1", "C: \ Temp \ Book1.xlsx", True
Importige Excel juurdepääsufunktsioonile
Seda funktsiooni saab kasutada Exceli faili või CSV -faili juurdepääsu tabelisse importimiseks.
Avalik funktsioon ImportFile (failinimi stringina, HasFieldNames Booleanina, tabeli nimi stringina) Boolean 'näite kasutamine: helista ImportFile ("Vali Exceli fail", "Exceli failid", "*.xlsx", "C: \", True , Tõsi, "ExcelImportTest", tõene, tõene, vale, tõene) Viga GoTo err_handler Kui (paremal (failinimi, 3) = "xls") Või ((paremal (failinimi, 4) = "xlsx")) Siis DoCmd. TransferSheetsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If (Right (Filename, 3) = "csv") Siis DoCmd.TransferText acLinkDelim,, TableName, Filename, True End If Exit_Thing: 'Clean up' Exceli tabel on juba olemas… ja kustutage see, kui see on olemas. Number = 3073) Ja errCount <3 Siis errCount = errCount + 1 ElseIf Err.Number = 3127 Siis MsgBox "Kõigi vahekaartide väljad on samad. Veenduge, et iga leht omab täpseid veerunimesid, kui soovite importida mitut ", vbCritical," MultiSheets not iden "ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number &" - "& Err.Description ImportFile = False GoTo Exit_Thing Resume End if End Function
Funktsiooni saate helistada järgmiselt:
Privaatne alamfail ImportFile_Example () Helista VBA_Access_ImportExport.ImportFile ("C: \ Temp \ Book1.xlsx", tõsi, "Imported_Table_1") Lõpu alam
Juurdepääs VBA ekspordile uude Exceli faili
Accessi objekti eksportimiseks uude Exceli faili kasutage DoCmd.OutputTo meetod või DoCmd.TransferSheetsheet meetod:
Ekspordi päring Excelisse
See VBA -koodi rida ekspordib päringu Excelisse, kasutades DoCmd. OutputTo:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c: \ temp \ ExportedQuery.xls"
Või võite selle asemel kasutada meetodit DoCmd.TransferSpreadsheet:
DoCmd.TransferSheetsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c: \ temp \ ExportedQuery.xls", True
Märge: See kood eksporditakse XLSX -vormingusse. Selle asemel saate värskendada argumente eksportimiseks CSV- või XLS -vormingusse (nt. acFormatXLSX et acFormatXLS).
Ekspordi aruanne Excelisse
See koodirida ekspordib aruande Excelisse, kasutades DoCmd.OutputTo:
DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c: \ temp \ ExportedReport.xls"
Või võite selle asemel kasutada meetodit DoCmd.TransferSpreadsheet:
DoCmd.TransferSheetsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c: \ temp \ ExportedReport.xls", True
Tabeli eksportimine Excelisse
See koodirida ekspordib tabeli Excelisse, kasutades DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c: \ temp \ ExportedTable.xls"
Või võite selle asemel kasutada meetodit DoCmd.TransferSpreadsheet:
DoCmd.TransferSheetsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c: \ temp \ ExportedTable.xls", True
Ekspordi vorm Excelisse
See koodirida ekspordib vormi Excelisse, kasutades DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c: \ temp \ ExportedForm.xls"
Või võite selle asemel kasutada meetodit DoCmd.TransferSpreadsheet:
DoCmd.TransferSheetsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c: \ temp \ ExportedForm.xls", True
Ekspordi Exceli funktsioonidesse
Need ühe rea käsud sobivad suurepäraselt uude Exceli faili eksportimiseks. Siiski ei saa nad eksportida olemasolevasse töövihikusse. Allpool olevas jaotises tutvustame funktsioone, mis võimaldavad eksportimise lisada olemasolevale Exceli failile.
Selle alla oleme lisanud mõned lisafunktsioonid uutesse Exceli failidesse eksportimiseks, sealhulgas veakäsitlus ja palju muud.
Ekspordi olemasolevasse Exceli faili
Ülaltoodud koodinäited sobivad suurepäraselt Accessi objektide eksportimiseks uude Exceli faili. Siiski ei saa nad eksportida olemasolevasse töövihikusse.
Accessi objektide eksportimiseks olemasolevasse Exceli töövihikusse oleme loonud järgmise funktsiooni:
Avalik funktsioon AppendToExcel (strObjectType As String, strObjectName As String, strSheetName As String, strFileName As String) Dim rst As DAO.Recordset Dim ApXL As Excel.Rakendus Dim xlWBk Nagu Excel.Töövihiku Dim xlWSh Nagu Excel.Worksight As Long = -4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 Valige juhtum strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRecordset (strObjectName, dbOpenDynaset, dbSeeChanges) Case "Vorm" Määra rst = Vormid (strObjectName) .RecordsetClone Case "Aruanne" Määra rst = CurrentDb.OpenRecordset (Aruanded (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) Lõpp Valige, kui rst.RecordCount = 0 Siis MsgBox " . ", vbInformation, GetDBTitle Else On Error Resume Next Set Määra xlWBk = ApXL.Töövihikud. Ava (strFil eName) Määrake xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Valige Do Before intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Nimi ApXL.ActiveCell.Offset (0, 1). Valige intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst With ApXL .Range ("A1"). Valige .Range (.Selection, .Selection.End (xlToRight)). Valige .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndSintinection xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Valige .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = FalseC. .EntireColumn.AutoFit xlWSh.Range ("A1"). Valige .Visible = True End with 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function
Funktsiooni saate kasutada järgmiselt.
Private Sub AppendToExcel_Example () Helista VBA_Access_ImportExport.ExportToExcel ("Tabel", "Tabel 1", "VBASheet", "C: \ Temp \ Test.xlsx") Lõpu alam
Pange tähele, et teil palutakse määratleda:
- Mida väljastada? Tabel, aruanne, päring või vorm
- Objekti nimi
- Väljundlehe nimi
- Väljundfaili tee ja nimi.
Ekspordi SQL -päring Excelisse
Selle asemel saate SQL -päringu Excelisse eksportida sarnase funktsiooni abil:
Avalik funktsioon AppendToExcelSQLStatemet (strsql Stringina, strSheetName As String, strFileName As String) Dim strQueryName String Dim ApXL nagu Excel. Rakendus Dim xlWBk As Excel. Töövihik Dim xlWSh nagu Excel. Töölehe Dim intCount As Integer Const = 4 xlBottom As Long = -4107 Const xlVAlignCenter = -4108 Const xlContinuous As Long = 1 Dim qdf As DAO.QueryDef Dim rst As DAO.Recordset strQueryName = "tmpQueryToExportToExcel" Kui ObjectExists ("QueryNorquerQuE Strue" Lõpeta, kui seatakse qdf = CurrentDb.CreateQueryDef (strQueryName, strsql) Määra rst = CurrentDb.OpenRecordset (strQueryName, dbOpenDynaset) Kui rst.RecordCount = 0 Siis MsgBox "Eksporditavaid kirjeid pole.", VbInformation, Get On Error ApXL = GetObject (, "Excel.Application") Kui Err.Number 0 Seejärel määrake ApXL = CreateObject ("Excel.Application") End If Err.Clear ApXL.Visible = False Set xlWBk = ApXL.Workbooks.Open (strFileName) Set xlWSh = xlWBk. leht s.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Valige Do Do till intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Nimi ApXL.ActiveCell.Offset ( 0, 1). Valige intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst koos ApXL .Range ("A1"). Valige .Range (.Selection, .Selection.End (xlToRight) ) .Valige .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0,25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Bertern.Lind.Lind.Line .EntireColumn.AutoFit .Cells. ("A1"). Valige .Visible = True End koos 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function
Nimetatakse nii:
Private Sub AppendToExcelSQLStatemet_Example () Helista VBA_Access_ImportExport.ExportToExcel ("SELECT * FROM Table1", "VBASheet", "C: \ Temp \ Test.xlsx") Lõpu alam
Kui teil palutakse sisestada:
- SQL päring
- Väljundlehe nimi
- Väljundfaili tee ja nimi.
Funktsioon uude Exceli faili eksportimiseks
Need funktsioonid võimaldavad teil Accessi objekte eksportida uude Exceli töövihikusse. Need võivad olla kasulikumad kui lihtsad üksikud read dokumendi ülaosas.
Avalik funktsioon ExportToExcel (strObjectType kui string, strObjectName kui string, valikuline strSheetName kui string, valikuline strFileName kui string) Dim rst as DAO.Recordset Dim ApXL objektina Dim xlWBk objektina Dim xlWSh As Object Dim intCl = Integer Const 4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 Viga GoTo ExportToExcel_Err DoCmd.Hourglass True Select Case strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRecordsName (strObpen , dbSeeChanges) Juhtum "Vorm" Määra rst = Vormid (strObjectName) .RecordsetClone Case "Aruanne" Määra rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) Lõpuks valige If rst.RecordCount = 0 kirjed, mis tuleb eksportida. ", vbInformation, GetDBTitle DoCmd.Hourglass False Else On Error Resume Next Set Viga. Tühjenda viga GoTo ExportToExcel_Err Määra xlWBk = ApXL.Workbooks.Add ApXL.Visible = False Set xlWSh = xlWBk.Worksheets ("Sheet1") Kui Len (strSheetName)> 0 Siis xlWSh.Name = Left (strSheet xNW, .Range ("A1"). Valige Tehke kuni intCount = esimesed väljad. Arvestus ApXL.ActiveCell = esimesed väljad (intCount). Nimi ApXL.ActiveCell.Offset (0, 1). Valige intCount = intCount + 1 silmus esimene. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset esmalt koos ApXL .Range ("A1"). Valige .Range (.Selection, .Selection.End (xlToRight)). Valige .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.Auto.Full. B2 "). Valige .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 "). Valige .Visible = True End Wi proovige uuesti: kui FileExists (strFileName) Seejärel tapke strFileName End If if strFileName "" Siis xlWBk.SaveAs strFileName, FileFormat: = 56 End If rst.Close Set rst = Nothing DoCmd.Hourglass False End If ExportToExcel_Exit Exx ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Resume ExportToExcel_Exit End Function
Funktsiooni võib nimetada järgmiselt:
Privaatne alameksport ExportToExcel_Example () Helista VBA_Access_ImportExport.ExportToExcel ("Tabel", "Tabel 1", "VBASheet") Lõpu alam
