Access VBA - Excelin tuonti / vienti - kysely, raportti, taulukko ja lomakkeet

Tämä opetusohjelma kattaa tapoja tuoda tietoja Excelistä Access -taulukkoon ja tapoja viedä Access -objektit (kyselyt, raportit, taulukot tai lomakkeet) Exceliin.

Tuo Excel -tiedosto Accessiin

Voit tuoda Excel -tiedoston Accessiin käyttämällä tuonti vaihtoehto DoCmd.TransferSpreadsheet :

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C: \ Temp \ Book1.xlsx", True

Tai voit käyttää DoCmd.TransferText CSV -tiedoston tuominen:

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

Tuo Excel Access -toimintoon

Tätä toimintoa voidaan käyttää Excel- tai CSV -tiedoston tuomiseen Access -taulukkoon:

Julkinen toiminto ImportFile (tiedostonimi merkkijonona, HasFieldNames Booleanina, taulukonimi merkkijonona) Boolen esimerkkikäytönä: soita ImportFile ("Valitse Excel -tiedosto", "Excel -tiedostot", "*.xlsx", "C: \", True , True, "ExcelImportTest", True, True, false, True) Virhe GoTo err_handler Jos (Oikea (Tiedostonimi, 3) = "xls") Tai ((Oikea (Tiedostonimi, 4) = "xlsx")) Sitten DoCmd. TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If If (Right (Filename, 3) = "csv") Sitten DoCmd.TransferText acLinkDelim,, TableName, Filename, True End If Exit_Thing: 'Clean up' Tarkista linkitetty Excel -taulukko on jo olemassa … ja poista se, jos näin on. Jos ObjectExists ("Table", TableName) = True Sitten DropTable (TableName) Aseta colWorksheets = Nothing Exit Function Numero = 3073) Ja errCount <3 Sitten errCount = errCount + 1 ElseIf Err.Number = 3127 Sitten MsgBox "Kaikkien välilehtien kentät ovat samat. Varmista, että jokainen arkki on täsmälliset sarakkeiden nimet, jos haluat tuoda useita ", vbCritical," MultiSheets not Identific "ImportFile = False GoTo Exit_Thing Muu MsgBox Err.Number &" - ​​"& Err.Description ImportFile = False GoTo Exit_Thing Jatka loppuun jos loppu

Voit kutsua funktion seuraavasti:

Private Sub ImportFile_Example () Soita VBA_Access_ImportExport.ImportFile ("C: \ Temp \ Book1.xlsx", True, "Imported_Table_1") Loppuosa

Avaa VBA -vienti uuteen Excel -tiedostoon

Vie Access -objekti uuteen Excel -tiedostoon käyttämällä DoCmd.OutputTo menetelmä tai DoCmd.TransferSpreadsheet -menetelmä:

Vie kysely Exceliin

Tämä VBA -koodirivi vie kyselyn Exceliin DoCmd: tä käyttäen.

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

Tai voit käyttää DoCmd.TransferSpreadsheet -menetelmää sen sijaan:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c: \ temp \ ExportedQuery.xls", True

Huomautus: Tämä koodi viedään XLSX -muotoon. Sen sijaan voit päivittää argumentit viedäksesi ne CSV- tai XLS -tiedostomuotoon (esim. acFormatXLSX kohteeseen acFormatXLS).

Vie raportti Exceliin

Tämä koodirivi vie raportin Exceliin DoCmd.OutputTo:

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

Tai voit käyttää DoCmd.TransferSpreadsheet -menetelmää sen sijaan:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c: \ temp \ ExportedReport.xls", True

Vie taulukko Exceliin

Tämä koodirivi vie taulukon Exceliin DoCmd.OutputTo:

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

Tai voit käyttää DoCmd.TransferSpreadsheet -menetelmää sen sijaan:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c: \ temp \ ExportedTable.xls", True

Vie lomake Exceliin

Tämä koodirivi vie lomakkeen Exceliin DoCmd.OutputTo:

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

Tai voit käyttää DoCmd.TransferSpreadsheet -menetelmää sen sijaan:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c: \ temp \ ExportedForm.xls", True

Vie Excel -toimintoihin

Nämä yhden rivin komennot toimivat loistavasti viennissä uuteen Excel -tiedostoon. He eivät kuitenkaan voi viedä olemassa olevaan työkirjaan. Alla olevassa osassa esittelemme toimintoja, joiden avulla voit liittää viennin olemassa olevaan Excel -tiedostoon.

Alla on lisätty joitakin lisätoimintoja, joita voidaan viedä uusiin Excel -tiedostoihin, kuten virheiden käsittely ja paljon muuta.

Vie olemassa olevaan Excel -tiedostoon

Yllä olevat koodiesimerkit toimivat loistavasti Access -objektien viemisessä uuteen Excel -tiedostoon. He eivät kuitenkaan voi viedä olemassa olevaan työkirjaan.

Vie Access -objektit olemassa olevaan Excel -työkirjaan, olemme luoneet seuraavan toiminnon:

Julkiset toiminnot 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 Excel As Long = -4161 Const xlCenter Niin kauan = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 Valitse tapaus 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 Valitse If rst.RecordCount = 0 Sitten MsgBoxed Ei . ", vbInformation, GetDBTitle Else On Error Resume Next Set Aseta xlWBk = ApXL.Workbooks.Open (strFil eName) Aseta xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Valitse Do Before intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Nimi ApXL.ActiveCell.Offset (0, 1) .Valitse intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst With ApXL .Range ("A1"). Valitse .Range (. .Selection.End (xlToRight)) .Valitse .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndSintintyyppi xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Valitse .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapTextSalse = FalseC. .EntireColumn.AutoFit xlWSh.Range ("A1"). Valitse .Visible = True End, jossa 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set

Voit käyttää toimintoa seuraavasti:

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

Huomaa, että sinua pyydetään määrittämään:

  • Mitä tulostaa? Taulukko, raportti, kysely tai lomake
  • Objektin nimi
  • Tulostusarkin nimi
  • Tulostustiedoston polku ja nimi.

Vie SQL -kysely Exceliin

Sen sijaan voit viedä SQL -kyselyn Exceliin käyttämällä vastaavaa toimintoa:

Julkinen toiminto AppendToExcelSQLStatemet (strsql merkkijonona, strSheetName kuin merkkijono, strFileName kuten merkkijono) Dim strQueryName Kuten merkkijono Dim ApXL kuten Excel.Application Dim xlWBk As Excel.Workbook Dim xlWSh Excel -muodossa xlBottom As Long = -4107 Const xlVAlignCenter = -4108 Const xlContinuous As Long = 1 Dim qdf Kuten DAO.QueryDef Dim rst As DAO.Recordset strQueryName = "tmpQueryToExportToExcel" Jos ObjectExists ("QueryNerquerQuue Strue" Loppu Jos Aseta qdf = CurrentDb.CreateQueryDef (strQueryName, strsql) Aseta rst = CurrentDb.OpenRecordset (strQueryName, dbOpenDynaset) Jos rst.RecordCount = 0 Sitten MsgBox "Ei vietäviä tietueita.", VbInformation, Get On Error ApXL = GetObject (, "Excel.Application") Jos Err.Number 0 Aseta sitten 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 = Vasen (strSheetName, 31) xlWSh.Range ("A1"). Valitse Tee kunnes intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Nimi ApXL.ActiveCell.Offset ( 0, 1) .Valitse intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst With ApXL .Range ("A1"). Valitse .Range (.Selection, .Selection.End (xlToRight) ) .Valitse .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0,25 .Selection.Interior.PatternTintAndShade = 0 .Valinta.Reilut .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Valitse .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColgeSolumn.Full. ("A1"). Valitse .Visible = True End jossa 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function

Kutsuttu näin:

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

Missä sinua pyydetään syöttämään:

  • SQL -kysely
  • Tulostusarkin nimi
  • Tulostustiedoston polku ja nimi.

Toiminto viedä uuteen Excel -tiedostoon

Näiden toimintojen avulla voit viedä Access -objekteja uuteen Excel -työkirjaan. Ne saattavat olla hyödyllisempiä kuin yksinkertaiset yksittäiset rivit asiakirjan yläosassa.

Julkiset toiminnot 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 intClT Integer Const 4161 Const xlCenter Niin kauan = -4108 Const xlBottom Niin kauan = -4107 Const xlContinuous As Long = 1 Virhe GoTo ExportToExcel_Err DoCmd.Hourglass True Select Case strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRecordsDame, strOb , dbSeeChanges) Case "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) Lopeta Valitse If first.RecordCount = B " viedtävät tietueet. ", vbInformation, GetDBTitle DoCmd.Hourglass False Else On Error Resume Next Set Err. Tyhjennä virhe GoTo ExportToExcel_Err Aseta xlWBk = ApXL.Workbooks.Add ApXL.Visible = False Set xlWSh = xlWBk.Worksheets ("Sheet1") Jos Len (strSheetName)> 0 Sitten xlWSh.Name = Left (strSheet IfName, .Range ("A1"). Valitse Tee kunnes intCount = ensimmäiset kentät. Laske ApXL.ActiveCell = ensimmäiset kentät (intCount) .Nimi ApXL.ActiveCell.Offset (0, 1). MoveFirst xlWSh.Range ("A2"). CopyFromRecordset ensimmäinen ApXL .Range ("A1"). Valitse .Range (.Selection, .Selection.End (xlToRight)). Valitse .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 "). Valitse .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 "). Valitse .Visible = True End Wi Yritä uudelleen: Jos FileExists (strFileName) Tapa sitten strFileName End If if strFileName "" Sitten xlWBk.SaveAs strFileName, FileFormat: = 56 End If rst.Close Set rst = Nothing DoCmd.Hourglass False End If ExportToExcel_Exit Exc ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Resume ExportToExcel_Exit End Function

Toimintoa voidaan kutsua seuraavasti:

Yksityinen osa ExportToExcel_Example () Soita VBA_Access_ImportExport.ExportToExcel ("Taulukko", "Taulukko1", "VBASheet") Lopeta alaosa
wave wave wave wave wave