VBA Access - Excluindo fontes de dados conectadas.

| Blog Office VBA | Blog Excel | Blog Access |

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, parte de códigos 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

Referências: Furniture Designer Brisbane 

Tags: 800, DAO Error, error, erro, List, tips, VBA, erros