Pristupite VBA - Uvoz / izvoz Excel - Upiti, izvješća, tablice i obrasci

Ovaj vodič će pokriti načine uvoza podataka iz Excela u Access tablicu i načine izvoza Access objekata (upite, izvješća, tablice ili obrasce) u Excel.

Uvezite Excel datoteku u Access

Za uvoz Excel datoteke u Access koristite acImport opciju od DoCmd.TransferSpreadsheet :

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

Ili možete koristiti DoCmd.TransferText za uvoz CSV datoteke:

DoCmd.TransferText acLinkDelim,, "Tablica1", "C: \ Temp \ Book1.xlsx", Istina

Uvezite Excel za funkciju pristupa

Ova se funkcija može koristiti za uvoz Excel datoteke ili CSV datoteke u tablicu pristupa:

Javna funkcija ImportFile (Naziv datoteke kao niz, HasFieldNames kao Boolean, TableName As String) Kao Boolean 'Primjer upotrebe: pozovite ImportFile ("Odaberite Excel datoteku", "Excel datoteke", "*.xlsx", "C: \", True , Istina, "ExcelImportTest", Istina, Istina, Neistina, Istina) Na pogrešku Idi na err_handler Ako (Desno (Naziv datoteke, 3) = "xls") Ili ((Desno (Naziv datoteke, 4) = "xlsx")) Zatim DoCmd. AcImport TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If If (Desno (Naziv datoteke, 3) = "csv") Zatim DoCmd.TransferText acLinkDelim,, TableName, File Name, True End if Exit_Thing: ' Excel tablica već postoji … i izbrišite je ako postoji. Ako ObjectExists ("Tablica", Naziv tablice) = Istina Zatim DropTable (Ime tablice) Postavite colWorksheets = Ništa Izlaz Funkcija err_handler: Ako (Err.Number = 3086 Ili Err.Number = 3274 Ili Err. Broj = 3073) I errCount <3 Zatim errCount = errCount + 1 OstaloAko je Err.Number = 3127 Zatim MsgBox "Polja na svim karticama su ista. Provjerite je li svaki list ima točne nazive stupaca ako želite uvesti više stavki ", vbCritical," Višestruki listovi nisu identični "ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number &" - ​​"& Err.Description ImportFile = False GoTo Exit_Thing Nastavi kraj ako završi funkciju

Funkciju možete pozvati ovako:

Privatni pod ImportFile_Example () Pozovite VBA_Access_ImportExport.ImportFile ("C: \ Temp \ Book1.xlsx", True, "Imported_Table_1") Kraj Sub

Pristupite VBA izvozu u novu Excel datoteku

Za izvoz Access objekta u novu Excel datoteku upotrijebite DoCmd.OutputTo metoda ili DoCmd.TransferSpreadsheet metoda:

Izvezite upit u Excel

Ova linija VBA koda izvest će upit u Excel pomoću DoCmd.OutputTo:

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

Ili umjesto toga možete koristiti metodu DoCmd.TransferSpreadsheet:

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

Bilješka: Ovaj kôd izvozi u XLSX format. Umjesto toga možete ažurirati argumente za izvoz u CSV ili XLS format datoteke (npr. acFormatXLSX do acFormatXLS).

Izvoz izvješća u Excel

Ovaj redak koda izvezit će izvješće u Excel pomoću DoCmd.OutputTo:

DoCmd.OutputTo acOutputReport, "Izvješće1", acFormatXLSX, "c: \ temp \ ExportedReport.xls"

Ili umjesto toga možete koristiti metodu DoCmd.TransferSpreadsheet:

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

Izvoz tablice u Excel

Ovaj redak koda izvest će tablicu u Excel pomoću DoCmd.OutputTo:

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

Ili umjesto toga možete koristiti metodu DoCmd.TransferSpreadsheet:

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

Izvezite obrazac u Excel

Ovaj redak koda će izvesti obrazac u Excel pomoću DoCmd.OutputTo:

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

Ili umjesto toga možete koristiti metodu DoCmd.TransferSpreadsheet:

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

Izvoz u Excel funkcije

Ove naredbe u jednom retku odlično funkcioniraju pri izvozu u novu Excel datoteku. Međutim, neće moći izvesti u postojeću radnu knjigu. U donjem odjeljku predstavljamo funkcije koje vam omogućuju dodavanje izvoza u postojeću Excel datoteku.

Ispod toga smo uključili neke dodatne funkcije za izvoz u nove Excel datoteke, uključujući rukovanje pogreškama i još mnogo toga.

Izvoz u postojeću Excel datoteku

Gornji primjeri koda odlično funkcioniraju pri izvozu Access objekata u novu Excel datoteku. Međutim, neće moći izvesti u postojeću radnu knjigu.

Za izvoz Access objekata u postojeću radnu knjigu programa Excel stvorili smo sljedeću funkciju:

Javna funkcija AppendToExcel (strObjectType kao niz, strObjectName kao niz, strSheetName kao niz, strFileName kao niz) Dim rst Kao DAO.Recordset Dim ApXL Kao Excel.Aplikacija Dim xlWBk Kao Excel.Radna knjiga Dim xlWShT Kao Excel. Dugo = -4161 Const xlCenter Kao dugo = -4108 Const xlBottom Dugo = -4107 Const xlKontinuirano kao dugo = 1 Odaberite slučaj strObjectType Slučaj "Tablica", "Upit" Postavi rst = CurrentDb.OpenRecordset (strObjectName, dbOpenDynaCeta, dbOpenDynaCeta, db "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) End Select If rst.RecordCount = 0 . ", vbInformation, GetDBTitle Ostalo Uključeno Pogreška Nastavi Sljedeće Postavi ApXL = GetObject (," Excel.Application ") Ako je Err.Number 0 Zatim postavite ApXL = CreateObject (" Excel.Application ") Kraj Ako je Err.Clear ApXL.Visible = False Postavite xlWBk = ApXL.Workbooks.Open (strFil eName) Postavite xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Odaberite Do Do intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) Naziv ApXL.ActiveCell.Offset (0, 1). Odaberite intCount = intCount + 1 petlja rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst s ApXL .Range ("A1"). Odaberite .Range (.Selection, .Izbor.Kraj (xlToRight)). Odaberite .Izbor.Interijer.Uzorak = xlSolid .Izbor.Interijer.UzorakBojaIndeks = xlAutomatski .Izbor.Interijer.TintAndShade = -0.25 .Izbor.Interijer. xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Odaberite .ActiveWindow.FreezePanes = True .ActiveSheet.Cells. Odaberite .ActiveSheet.Cells. .EntireColumn.AutoFit xlWSh.Range ("A1"). Odaberite .Visible = True End With 'xlWB.Close True' Set xlWB = Ništa 'ApXL.Quit' Postavi ApXL = Ništa ne završava ako funkcija End

Funkciju možete koristiti ovako:

Privatni dodatak AppendToExcel_Example () Pozovite VBA_Access_ImportExport.ExportToExcel ("Tablica", "Tablica1", "VBASheet", "C: \ Temp \ Test.xlsx") Kraj

Primijetite da se od vas traži da definirate:

• Što ispisati? Tablica, izvješće, upit ili obrazac
• Naziv objekta
• Naziv izlaznog lista
• Put i naziv izlazne datoteke.

Izvezite SQL upit u Excel

Umjesto toga možete izvesti SQL upit u Excel koristeći sličnu funkciju:

Javna funkcija AppendToExcelSQLStatemet (strsql kao niz, strSheetName kao niz, strFileName kao niz) Dim strQueryName kao niz Dim ApXL kao Excel.Aplikacija Dim xlWBk kao Excel.Radna knjiga Dim xlWSh kao Excel.Worksheet Dim InstC8 xlBottom Dokle = -4.107 Const xlVAlignCenter = -4.108 Const xlContinuous Dokle = 1 Dim qdf Kao DAO.QueryDef Dim prvo Kao DAO.Recordset strQueryName = "tmpQueryToExportToExcel" Ako ObjectExists ( "Upit", strQueryName), a zatim CurrentDb.QueryDefs.Delete strQueryName Završi ako je postavljeno qdf = CurrentDb.CreateQueryDef (strQueryName, strsql) Postavi rst = CurrentDb.OpenRecordset (strQueryName, dbOpenDynaset) Ako je rst.RecordCount = 0 Zatim MsgBox "Nema zapisa za izvoz.", V.Br. ApXL = GetObject (, "Excel.Application") Ako je Err.Number 0 Zatim postavite ApXL = CreateObject ("Excel.Application") Kraj ako je Err.Clear ApXL.Visible = False Set xlWBk = ApXL.Workbooks.Open (strFileName) Set xlWSh = xlWBk.Last s.Dodaj xlWSh.Name = Lijevo (strSheetName, 31) xlWSh.Range ("A1"). Odaberite Učini do intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Naziv ApXL.ActiveCell.Offset ( 0, 1). Odaberite intCount = intCount + 1 petlja rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst s ApXL .Range ("A1"). Odaberite .Range (.Selection, .Selection.End (xlToRight) ) .Odaberite .Izbor.Interijer.Uzorak = xlSolidan .Izbor.Interijer.UzorakBojeIndeks = xlAutomatski .Izbor.Interijer.TintAndShade = -0.25 .Izbor.Interijer.UzorakTintAndShade = 0 .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Odaberite .ActiveWindow.FreezePanes = True .ActiveSheet.Cells. Odaberite .ActiveSheet.Cells.WrapText = False. ("A1"). Odaberite .Visible = True End with 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Ništa ne završava ako funkcija End

Ovako se zove:

Privatni dodatak AppendToExcelSQLStatemet_Example () Pozovite VBA_Access_ImportExport.ExportToExcel ("SELECT * FROM Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub

Gdje se od vas traži da unesete:

• SQL upit
• Naziv izlaznog lista
• Put i naziv izlazne datoteke.

Funkcija za izvoz u novu Excel datoteku

Ove vam funkcije omogućuju izvoz objekata Access u novu Excel radnu knjigu. Možda će vam biti korisniji od jednostavnih pojedinačnih redaka pri vrhu dokumenta.

Javna funkcija ExportToExcel (strObjectType As String, strObjectName As String, Optional strSheetName As String, Optional strFileName As String) Dim rst Kao DAO.Recordset Dim ApXL As Dim Object xlWBk As Object Dim xlWSh As Object Dim 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 Slučaj "Tablica", "Upit" Set rst = CurrentDb.OpenDeset, OpenString , dbSeeChanges) Case "Form" Set rst = Forms (strObjectName) .RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset (Reports (strObjectName) .RecordSource, dbOpenDynaset, dbSeeChanges) zapisi za izvoz. ", vbInformation, GetDBTitle DoCmd.Hourglass False Else On Error Nastavi dalje Sljedeće Postavi ApXL = GetObject (," Excel.Application ") Ako je Err.Number 0 Tada postavite ApXL = CreateObject (" Excel.Application ") End If Err. Pogreška brisanja pri pokretanju Idi na ExportToExcel_Err Set xlWBk = ApXL.Workbooks.Add ApXL.Visible = False Set xlWSh = xlWBk.Worksheets ("Sheet1") If Len (strSheetName)> 0 then xlWSh.NameSheme .Range ("A1"). Odaberite Do Do intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Naziv ApXL.ActiveCell.Offset (0, 1). Odaberite intCount = intCount + 1 Petlja rst. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst With ApXL .Range ("A1"). Select .Range (.Selection, .Selection.End (xlToRight)). Select .Selection.Interior.Pattern = xlSolid .Selection. Interijer.UzorakBojaIndeks = xlAutomatski .Izbor.Interijer.TintAndShade = -0.25 .Izbor.Interijer.UzorakTintAndShade = 0 .Izbor.Granice.LineStil = xlNone .Izbor.AutoFilter. Ceo. B2 "). Odaberite .ActiveWindow.FreezePanes = True .ActiveSheet.Cells. Odaberite .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 "). Odaberite. Ponovni pokušaj: Ako FileExists (strFileName) Zatim ubijte strFileName End If If strFileName "" Tada xlWBk.SaveAs strFileName, FileFormat: = 56 End If rst.Close Postavi rst = Ništa DoCmd.Hourglass False End Ako ExportToExssConit False ExitToExcelConit False ExitToExcelConit False ExitToExcelExcell False End ExportToExcelContaža False Izvrši ExoToExcel Funkcija False End ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Resume ExportToExcel_Exit Krajnja funkcija

Funkcija se može nazvati ovako:

Privatni pod ExportToExcel_Example () Pozovite VBA_Access_ImportExport.ExportToExcel ("Tablica", "Tablica1", "VBASheet") Kraj pod