... Assinatura do site por 1 ano + Kit MontaRibbons + 3 Livros em PDF + Diversas Revistas (pdf) de brinde, por apenas R$100,00
(
podendo parcelar em até 10 vezes no cartão de crédito)...

Clique aqui e obtenha mais detalhes do nosso kit completo e de como comprar.


Vincular novas tabelas pelo VBA

Usuário Assis:

Avelino, preciso  de  um  projeto, em MDB, que identifique e vincule as novas tabelas inseridas no back-end.

Suporte:

Assis, o código tem que percorrer as tabelas do back-end e ir verificando se elas existem ou não, no front-end.  Observe no código abaixo, que primeiro se percorre as tabelas do front-end para verificar se estão com os vínculos quebrados.  Os vínculos quebrados são deletados. 

Atente para os comentários no código.

Public Sub fncVincular()
Dim be As DAO.Database
Dim tbl As DAO.TableDef
Dim LocalBe$

LocalBe = CurrentProject.Path & "\vincular_be.mdb"

'Percorre as tabelas no front-end e verifica se tem tabelas com vínculos quebrados
For Each tbl In CurrentDb.TableDefs
    If Left(tbl.Name, 4) <> "MSys" And Left(tbl.Name, 4) <> "Usys" Then
        If Not fncTabelaExiste(tbl.Name) Then
            'Excluir vínculo da tabela não existente no back-end
            DoCmd.DeleteObject acTable, tbl.Name
        End If
    End If
Next

Set be = DBEngine.OpenDatabase(LocalBe, False, False, ";PWD=a1234")
'Percorre as tabelas do back-end e verifica uma a uma,se está ou não,vinculada no front-end
For Each tbl In be.TableDefs
    If Left(tbl.Name, 4) <> "MSys" And Left(tbl.Name, 4) <> "Usys" Then
        If Not fncTabelaExiste(tbl.Name) Then
  'Realiza a vinculação da tabela não existente no front-end
  DoCmd.TransferDatabase acLink, "Microsoft Access", LocalBe, acTable, tbl.Name, tbl.Name
        End If
    End If
Next
be.Close

MsgBox "Tabelas Vinculadas..", vbInformation, "Aviso"
Set be = Nothing
Set tbl = Nothing
End Sub

A função que verifica se a tabela existe no front-end é esta:

Public Function fncTabelaExiste(strNomeTabela As String) As Boolean
Dim rs As DAO.Recordset
'---------------------------------------------------------------
'Solicita ao VBA que prossiga com a execução do código,
'mesmo havendo erro e sem mostrar nenhuma mensagem.
'---------------------------------------------------------------
On Error Resume Next
'-----------------------------------
'Abre a tabela pesquisada
'-----------------------------------
Set rs = CurrentDb.OpenRecordset(strNomeTabela)
'---------------------------------------------------------------
'Se a tabela não existir, haverá erro e o valor(3078/3024) será
'armazenado no objeto Err.  Este valor poderá ser investigado
'através do comando Err.number
'---------------------------------------------------------------
Select Case Err.Number
    Case 3078, 3024
        fncTabelaExiste = False
    Case 0
        fncTabelaExiste = True
End Select

Set rs = Nothing
End Function

Segue abaixo o arquivo para você testar.  Abra o formulário frmTeste e clique no botão.

Crie uma nova tabela no back-end e faça novamente o teste pelo front-end e veja se a nova tabela será ou não, vinculada.

Download

 


 

 


2 comentário(s)

Paulo Maia   17/02/2018 20:50:44

Gostaria de Saber, -> E no caso de ter 05 BE com tabelas a serem vinculadas e conferidas no front-end ? onde mudaria e como fica o código ?

Avelino Sampaio   20/02/2018 00:15:10

Paulo,

abra um tópico sobre o assunto lá no meu fórum, que tentarei te oferecer um exemplo, baseado no exemplo oferecido aqui.

http://www.redeaccess.com.br

No aguardo


Envie seu comentário: