Quando criamos aplicações de automação com o MS Access não é raro precisarmos efetuar conexões em diversas bases de dados como: planilhas MS Excel, arquivos Texto, ou outras tabelas MS Access, sites da Web, etc...
Essas conexões geralmente precisam ser refeitas e/ou excluídas. Como fazê-lo?
Demonstro abaixo, partes de código com variantes para aplicar ao seu gosto...Boa diversão!
Esta primeira função é muito rápida, ela checa se o objeto que desejamos excluir está disponível para deleção:
- CÓDIGO:
Function CheckExistTbl(tblName As String) As Integer
' Author: Date: Contact: URL:
' André Bernardes 09/11/2010 09:45 bernardess@gmail.com https://sites.google.com/site/vbabernardes/
' Application:
' Detecta a tabela e a deleta.
Dim i As Integer ' Counter.
Let CheckExistTbl = False
For i = 0 To CurrentData.AllTables.Count - 1
If CurrentData.AllTables(i).Name = tblName Then
Let CheckExistTbl = True
End If
Next i
End Function
Por exemplo:
- CÓDIGO:
If CheckExistTbl(strConectionTbl01) Then
DoCmd.DeleteObject acTable, strConectionnTbl01
Endif
Abaixo demonstro uma das inúmeras técnicas para se conectar dados à sua aplicação MS Access, neste caso efetuo conexões a outras bases MS Access.
- CÓDIGO:
Function ConectAll(nBase As String, strConection As String)
' Author: Date: Contact: URL:
' André Bernardes 09/11/2010 09:31 bernardess@gmail.com https://sites.google.com/site/vbabernardes/
' Application:
' Efetua as conexões.
Dim dbsTemp As Database
Dim strMenu As String
Dim strInput As String
Dim nTbl01 As String
Dim nTbl02 As String
Dim nTbl03 As String
' Tabelas
nTbl01 = "tbl_01x"
nTbl02 = "tbl_02y"
nTbl03 = "tbl_03k"
Set dbsTemp = CurrentDb
' Deleta os objetos pré-existentes.
If CheckExistTbl(strConection & nTbl01) Then
Call Banner("Desconectando tabela:" & strConection & nTbl01)
DoCmd.DeleteObject acTable, strConection & nTbl01
Call Banner("Desconectando tabela:" & strConection & nTbl02)
DoCmd.DeleteObject acTable, strConection & nTbl02
Call Banner("Desconectando tabela:" & strConection & nTbl03)
DoCmd.DeleteObject acTable, strConection & nTbl03
End If
' Conecta o grupo de tabelas respectivas ao mês de análise.
Call Banner("Conectando a tabela: " & strConection & nTbl01)
ConnectOutput dbsTemp, strConection & nTbl01, ";DATABASE=" & nBase, nTbl01
Call Banner("Conectando a tabela: " & strConection & nTbl02)
ConnectOutput dbsTemp, strConection & nTbl02, ";DATABASE=" & nBase, nTbl02
Call Banner("Conectando a tabela: " & strConection & nTbl03)
ConnectOutput dbsTemp, strConection & nTbl03, ";DATABASE=" & nBase, nTbl03
End Function
Perceba no código acima a utilização das funções explanadas anteriormente.
Abaixo observaremos a simples e suave conexão da fonte de dados com o banco de dados atual:
- CÓDIGO:
Sub ConnectOutput(dbsTmp As Database, strTbl As String, strConnect As String, strSourceTbl As String)
' Author: Date: Contact: URL:
' André Bernardes 09/11/2010 08:01 bernardess@gmail.com https://sites.google.com/site/vbabernardes/
' Application:
' Efetua as conexões.
Dim tblLinked As TableDef
Set tblLinked = dbsTmp.CreateTableDef(strTbl)
Let tblLinked.Connect = strConnect
Let tblLinked.SourceTableName = strSourceTbl
dbsTmp.TableDefs.Append tblLinked
End Sub
Outra técnica também eficiente, seria utilizar o código abaixo:
- CÓDIGO:
Dim d_b As Database
On Error GoTo ProcessingErrorMsg:
Set d_b = CurrentDb()
d_b.TableDefs.Delete "tbl_Bernardes"
Exit Sub
ProcessingErrorMsg:
Select Case Err.Number
Case 3265 'Table
Resume Next
Case Else
MsgBox Err.Number & " - Descrição: " & Err.Description, vbExclamation, Err.Source
End Select
Reference:
BRAZIL MICROSOFT ACCESS DEVELOPER
VBA Access - Removendo campos
http://brzaccessdeveloper.blogspot.com/2009/11/vba-access-removendo-campos.html
Função para saber se existe
http://inanyplace.blogspot.com/2009/11/vba-access-funcao-para-saber-se-existe.html
Nenhum comentário:
Postar um comentário