Acessar tabelas VBA - Atualizar, Contar, Excluir, Criar, Renomear, Exportar

Este tutorial irá ensiná-lo a trabalhar com tabelas de acesso usando VBA.

Acessar tabelas VBA

Para começar, demonstraremos os comandos simples para trabalhar com tabelas no Access. Posteriormente neste tutorial, mostraremos funções totalmente desenvolvidas profissionalmente para trabalhar com tabelas no Access.

Criar a tabela

Este código usará SQL para criar uma tabela chamada “Tabela1” com os campos “ID” e “Nome”:

 Dim table_name As String Dim fields As String table_name = "Table1" fields = "([ID] varchar (150), [Name] varchar (150))" CurrentDb.Execute "CREATE TABLE" & table_name & fields

Fechar mesa

Esta linha de código VBA fechará uma Tabela (salvando as alterações):

DoCmd.Close acTable, "Table1", acSaveYes

Para fechar uma tabela sem salvar:

DoCmd.Close acTable, "Table1", acSaveNo

Apagar Tabela

Este código excluirá uma Tabela (nota: primeiro a Tabela deve ser fechada):

DoCmd.Close acTable, "Table1", acSaveYes DoCmd.DeleteObject acTable = acDefault, "Table1"

Renomear tabela:

Esta linha de código renomeará uma Tabela de Acesso:

DoCmd.Rename "Table1", acTable, "Table1_New"

Outra opção é usar a propriedade TableDefs de um objeto de banco de dados.

Definir tdf = db.TableDefs (strOldTableName) tdf.Name = strNewTableName

Tabela Vazia / Limpar

Este código VBA esvaziará uma Tabela:

DoCmd.RunSQL "DELETE * FROM" & "Table1"

Truncar tabela / excluir registros

Esta linha de código VBA usa SQL para excluir registros de uma tabela que atendem a certos critérios:

DoCmd.RunSQL ("DELETE * FROM" & "Table1" & "WHERE" & "num = 2")

Exportar Tabela para Excel

Para exportar uma tabela para o Excel, use o DoCmd.OutputTo método:

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

ou use o DoCmd.TransferSpreadsheet método:

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

Tabela de atualização

O código a seguir atualizará um registro, sem exibir a mensagem de aviso:

DoCmd.SetWarnings (False) DoCmd.RunSQL "Atualizar ProductsT SET ProductsT.ProductName = 'Product AAA' WHERE (((ProductsT.ProductID) = 1))"

Acessar funções da tabela VBA

Os exemplos de código acima são comandos simples que você pode usar para interagir com tabelas usando o VBA. No entanto, você frequentemente precisará adicionar muito mais código de suporte (incluindo tratamento de erros) para utilizar esses comandos de maneira adequada. Abaixo você encontrará funções de desenvolvimento profissional para trabalhar com Tabelas no Access.

Registros da Tabela de Contagem

Esta função contará o número de registros em uma tabela:

Função pública Count_Table_Records (TableName As String) As Integer On Error GoTo Err: Dim r As DAO.Recordset Dim c As Integer Set r = CurrentDb.OpenRecordset ("Selecione count (*) as rcount de" & TableName) .OpenRecordset If (r .EOF) Then c = 0 Else c = Nz (r! RCount, 0) End If Count_Table_Records = c Exit Function Err: Call MsgBox ("Ocorreu um erro:" & Err.Description, vbExclamation, "Error") End Function ' Exemplo de uso Private Sub Count_Table_Records_Example () MsgBox (Count_Table_Records ("Table1")) End Sub

Verifique se a tabela existe função

Esta função testará se existe uma tabela, retornando TRUE ou FALSE:

Função pública TableExists (ByVal strTableName As String) As Boolean 'Função: Determina se a tabela existe em um banco de dados Access' Argumentos: strTablename: Nome da tabela para verificar Dim tdf As DAO.TableDef On Error Resume Next Set tdf = CurrentDb.TableDefs (strTableName ) TableExists = (Err.Number = 0) Função Final

Aqui está um exemplo da função em uso:

Private Sub TableExists_Example () If VBA_Access_Checks.TableExists ("Table") = True Then MsgBox ("Table was found!") Else MsgBox ("Table was NOT found!") End If End Sub

Criar Função de Tabela

Esta função irá criar uma Tabela no Access VBA no Banco de Dados Atual:

Função pública CreateTable (table_fields As String, table_name As String) As Boolean Dim strCreateTable As String Dim intCount As Integer Dim strFields () As String Dim strValues ​​() As String Dim strInsertSQL As String Dim intCounter As Integer Dim intData As Integer On Error GoTo strFields = Split (table_fields, ",") strCreateTable = "CREATE TABLE" & table_name & "(" For intCounter = 0 To UBound (strFields) - 1 strCreateTable = strCreateTable & "[" & strFields (intCounter) & "] varchar ( 150), "Next If Right (strCreateTable, 1) =", "Then strCreateTable = Left (strCreateTable, Len (strCreateTable) - 1) strCreateTable = strCreateTable &") "End If CurrentDb.Execute strCreateTable intCounter = 0 intData = 0 If Err.Number = 0 Then CreateTable = True Else CreateTable = False End If Exit Function Err: CreateTable = False MsgBox Err.Number & "" & Err.Description End Function

Esta função retornará TRUE se a tabela for criada com sucesso ou FALSE se a tabela não for criada.

Você pode chamar a função assim:

Private Sub CreateTable_Example () Chame CreateTable ("f1, f2, f3, f4", "ttest") End Sub

Função Excluir / Eliminar Tabela

Esta função excluirá uma tabela se ela existir:

Função pública DeleteTableIfExists (TableName As String) If Not IsNull (DLookup ("Name", "MSysObjects", "Name = '" & TableName & "'")) Then DoCmd.SetWarnings False DoCmd.Close acTable, TableName, acSaveYes DoCmd. DeleteObject acTable = acDefault, TableName Debug.Print "Table" & TableName & "deleted…" DoCmd.SetWarnings True End If End Function

Você pode chamar a função assim:

Private Sub DeleteTableIfExists_Example () Chame DeleteTableIfExists ("Table1") End Sub

Função de mesa vazia

Esta função esvaziará uma tabela se ela existir:

Função pública EmptyTable (TableName As String) If Not IsNull (DLookup ("Name", "MSysObjects", "Name = '" & TableName & "'")) Then DoCmd.SetWarnings False DoCmd.RunSQL "DELETE * FROM" & TableName Debug.Print "Table" & TableName & "emptied…" DoCmd.SetWarnings True End If End Function

Você pode chamar a função assim:

Private Sub EmptyTable_Example () Chamar EmptyTable ("Table1") End Sub

Função Renomear Tabela

Esta função VBA renomeará uma tabela:

Função pública RenameTable (ByVal strOldTableName As String, ByVal strNewTableName As String, Opcional strDBPath As String) As Boolean Dim db As DAO.Database Dim tdf As TableDef 'Trap for any errors. On Error Resume Next 'Se o nome do banco de dados estiver vazio… If Trim $ (strDBPath) = "" Then'… então defina Db para o Db atual. Set db = CurrentDb () Else 'Caso contrário, defina Db para o banco de dados aberto especificado. Set db = DBEngine.Workspaces (0) .OpenDatabase (strDBPath) 'Veja se ocorreu um erro. If Err Then 'MsgBox "Não foi possível encontrar o banco de dados para abrir:" & strDBPath RenameTable = False Função de saída End If End If If ObjectExists ("Table", strOldTableName, strDBPath) Then Set tdf = db.TableDefs (strOldTableName) tdf.Name = strNewTableName db.Close RenameTable = True Else RenameTable = False End If End Function 'Exemplo de uso Privado Sub RenameTable_Example () Chame RenameTable ("table1", "table2") End Sub

Você pode chamar a função assim:

Private Sub RenameTable_Example () Chame RenameTable ("table1", "table2") End Sub

Truncar / excluir registros da tabela

Esta função excluirá registros de uma tabela com tratamento de erros:

Função pública Delete_From_Table (TableName As String, Criteria As String) On Error GoTo SubError DoCmd.SetWarnings False DoCmd.RunSQL ("DELETE * FROM" & TableName & "WHERE" & Criteria) DoCmd.SetWarnings True SubExit: Exit Function SubError: Msg " Erro Delete_From_Table: "& vbCrLf & Err.Number &": "& Err.Description Resume SubExit End Function 'Use Public Sub Delete_From_Table_Example () Chame Delete_From_Table (" Table1 "," num = 2 ") End Sub

Exportar Tabela para Excel

Esta linha de código exportará uma tabela para o Excel (uma nova planilha):

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

Ou você pode usar esta função:

Função pública Export_Table_Excel (TableName As String, FilePath As String) DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, TableName, FilePath, True End Function 'Exemplo de uso Sub Export_Table_Excel_Example () Export_Table_Excel ("Table.x1", "c: \ templs \ Exported) End Sub

O código acima será exportado para uma nova planilha. Em vez disso, você pode adicionar uma tabela a uma planilha existente. Nosso artigo sobre Importação / Exportação no Access VBA aborda isso com mais detalhes.

Adicionar / anexar registros a uma tabela

Esta função irá adicionar / anexar um registro a uma tabela:

Função pública Append_Record_To_Table (TableName As String, FieldName As String, FieldValue As String) On Error GoTo SubError Dim rs As DAO.Recordset Dim SQL As String Dim CurrentYear As Integer Set rs = CurrentDb.OpenRecordset (TableName) rs.AddNew rs (FieldName) .Value = FieldValue rs.Update rs.Close Set rs = Nothing SubExit: Exit Function SubError: MsgBox "Erro RunSQL:" & vbCrLf & Err.Number & ":" & Err.Description Resume SubExit End Function 'Use Exemplo Private Sub Append_Record_To_Table_Example () Chame Append_Record_To_Table ("Table1", "num", 3) End Sub

Adicionar registro à tabela do formulário

Esta função adicionará um registro a uma tabela a partir de um formulário:

Função pública Add_Record_To_Table_From_Form (TableName As String) On Error GoTo SubError Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset (TableName) rs.AddNew 'rs! [Field1] = Value1' rs! [Field2] = Value2 'rs! [Field2] = Value2' rs! Field3] = Value3 rs.Update rs.Close Set rs = Nothing SubExit: Exit Function SubError: MsgBox "Erro Refresh_Form:" & vbCrLf & Err.Number & ":" & Err.Description End Function