Este tutorial cobrirá as maneiras de importar dados do Excel para uma Tabela do Access e as maneiras de exportar objetos do Access (Consultas, Relatórios, Tabelas ou Formulários) para o Excel.
Importar arquivo do Excel para acesso
Para importar um arquivo Excel para o Access, use o acImportar opção de DoCmd.TransferSpreadsheet :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C: \ Temp \ Book1.xlsx", True
Ou você pode usar DoCmd.TransferText para importar um arquivo CSV:
DoCmd.TransferText acLinkDelim,, "Tabela1", "C: \ Temp \ Book1.xlsx", Verdadeiro
Importar Excel para acessar a função
Esta função pode ser usada para importar um arquivo Excel ou CSV para uma Tabela de Acesso:
Public Function ImportFile (Filename As String, HasFieldNames As Boolean, TableName As String) As Boolean 'Exemplo de uso: call ImportFile ("Selecione um arquivo Excel", "Excel Files", "* .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: 'Limpar' Verifique se nosso link A tabela do Excel já existe… e exclua-a em caso afirmativo If ObjectExists ("Table", TableName) = True Then DropTable (TableName) Defina colWorksheets = Nothing Exit Function err_handler: If (Err.Number = 3086 Ou Err.Number = 3274 Ou Err. Number = 3073) And errCount <3 Then errCount = errCount + 1 ElseIf Err.Number = 3127 Then MsgBox "Os campos em todas as guias são iguais. Certifique-se de que cada folha tem os nomes de coluna exatos se você deseja importar múltiplas ", vbCritical," MultiSheets não idênticas "ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number &" - "& Err.Description ImportFile = False GoTo Exit_Thing Resume End If End Function
Você pode chamar a função assim:
Private Sub ImportFile_Example () Call VBA_Access_ImportExport.ImportFile ("C: \ Temp \ Book1.xlsx", True, "Imported_Table_1") End Sub
Acessar Exportação VBA para Novo Arquivo Excel
Para exportar um objeto do Access para um novo arquivo do Excel, use o DoCmd.OutputTo método ou o Método DoCmd.TransferSpreadsheet:
Exportar consulta para Excel
Esta linha de código VBA exportará uma consulta para Excel usando DoCmd.OutputTo:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c: \ temp \ ExportedQuery.xls"
Ou você pode usar o método DoCmd.TransferSpreadsheet em vez disso:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c: \ temp \ ExportedQuery.xls", True
Observação: Este código é exportado para o formato XLSX. Em vez disso, você pode atualizar os argumentos para exportar para um formato de arquivo CSV ou XLS (por exemplo, acFormatXLSX para acFormatXLS).
Exportar relatório para Excel
Esta linha de código exportará um relatório para o Excel usando DoCmd.OutputTo:
DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c: \ temp \ ExportedReport.xls"
Ou você pode usar o método DoCmd.TransferSpreadsheet em vez disso:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c: \ temp \ ExportedReport.xls", True
Exportar Tabela para Excel
Esta linha de código exportará uma tabela para o Excel usando DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Tabela1", acFormatXLSX, "c: \ temp \ ExportedTable.xls"
Ou você pode usar o método DoCmd.TransferSpreadsheet em vez disso:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c: \ temp \ ExportedTable.xls", True
Exportar formulário para Excel
Esta linha de código exportará um formulário para Excel usando DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c: \ temp \ ExportedForm.xls"
Ou você pode usar o método DoCmd.TransferSpreadsheet em vez disso:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c: \ temp \ ExportedForm.xls", True
Exportar para funções do Excel
Esses comandos de uma linha funcionam muito bem para exportar para um novo arquivo do Excel. No entanto, eles não poderão exportar para uma pasta de trabalho existente. Na seção abaixo, apresentamos funções que permitem anexar sua exportação a um arquivo Excel existente.
Abaixo disso, incluímos algumas funções adicionais para exportar para novos arquivos do Excel, incluindo tratamento de erros e muito mais.
Exportar para arquivo Excel existente
Os exemplos de código acima funcionam muito bem para exportar objetos do Access para um novo arquivo do Excel. No entanto, eles não poderão exportar para uma pasta de trabalho existente.
Para exportar objetos do Access para uma pasta de trabalho Excel existente, criamos a seguinte função:
Função pública 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 x As Long = -4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 Selecione 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 "Nenhum registro a ser exportado . ", 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 Defina xlWBk = ApXL.Workbooks.Open (strFil eName) Defina xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left (strSheetName, 31) xlWSh.Range ("A1"). Selecione Do Até intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount). Nome ApXL.ActiveCell.Offset (0, 1) .Selecione intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset primeiro Com ApXL .Range ("A1"). Selecione .Range (.Selection, .Selection.End (xlToRight)). Selecione .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndineShade = 0. xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Selecione .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.Cells.WrapText = False .ActiveSheet.Cells.WrapText = False. .EntireColumn.AutoFit xlWSh.Range ("A1"). Selecione .Visible = True End With 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function
Você pode usar a função assim:
Private Sub AppendToExcel_Example () Chamar VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Observe que você é solicitado a definir:
- O que produzir? Tabela, relatório, consulta ou formulário
- Nome do Objeto
- Nome da folha de saída
- Caminho e nome do arquivo de saída.
Exportar consulta SQL para Excel
Em vez disso, você pode exportar uma consulta SQL para o Excel usando uma função semelhante:
Função pública 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 As Long = -4108 Const. 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 strQueryName) Then CurrentDb.QueryDefs.Query. End If Set qdf = CurrentDb.CreateQueryDef (strQueryName, strsql) Set rst = CurrentDb.OpenRecordset (strQueryName, dbOpenDynaset) If rst.RecordCount = 0 Then MsgBox "Nenhum registro a ser exportado.", V ResumeDb.OpenRecordset (strQueryName, dbOpenDynaset) If rst.RecordCount = 0 Then MsgBox "Nenhum registro a ser exportado." 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"). Selecione Do Até intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset ( 0, 1) .Selecione intCount = intCount + 1 Loop rst.MoveFirst xlWSh.Range ("A2"). CopyFromRecordset primeiro Com ApXL .Range ("A1"). Selecione .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. .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range ("B2"). Selecione .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.Entire.Colange.AutoFit xl ("A1"). Selecione .Visible = True End With 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit' Set ApXL = Nothing End If End Function
Chamado assim:
Private Sub AppendToExcelSQLStatemet_Example () Chame VBA_Access_ImportExport.ExportToExcel ("SELECT * FROM Table1", "VBASheet", "C: \ Temp \ Test.xlsx") End Sub
Onde você é solicitado a inserir:
- Consulta SQL
- Nome da folha de saída
- Caminho e nome do arquivo de saída.
Função para exportar para um novo arquivo Excel
Essas funções permitem exportar objetos do Access para uma nova pasta de trabalho do Excel. Você pode considerá-los mais úteis do que as simples linhas únicas no topo do documento.
Função pública ExportToExcel (strObjectType As String, strObjectName As String, Opcional strSheetName As String, Opcional 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 On Error GoTo ExportToExcel_Err DoCmd.Hourglass True Select Case strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRecordset (strObjectName, db , 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 registros a serem exportados. ", 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 Errar. Limpar em caso de erro 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"). Selecione Do Até intCount = rst.fields.Count ApXL.ActiveCell = rst.fields (intCount) .Name ApXL.ActiveCell.Offset (0, 1) .Selecione intCount = intCount + 1 Loop primeiro. MoveFirst xlWSh.Range ("A2"). CopyFromRecordset rst Com ApXL .Range ("A1"). Selecione .Range (.Selection, .Selection.End (xlToRight)). Selecione .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. B2 "). Selecione .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range (" A1 "). Selecione .Visible = True End Wi ª tentativa: 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 Sair Função ExportToExcel_Err: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Retomar ExportToExcel_Exit Função final
A função pode ser chamada assim:
Private Sub ExportToExcel_Example () Chame VBA_Access_ImportExport.ExportToExcel ("Table", "Table1", "VBASheet") End Sub
