Vincular novas tabelas pelo VBA
Nota importante: para ter acesso aos vídeos e arquivos exemplos deste site, adquira um dos planos apresentados abaixo. Você pode comprar em até 5x no Cartão de Crédito.
Veja como comprar e saiba mais sobre o material oferecido, clicando aqui.
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
3 comentário(s) Avelino Sampaio 20/02/2023 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 Paulo Maia 17/02/2023 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 ? Victor Marques 24/08/2021 07:30:59 Avelino bom dia, primeiramente gostaria de parabenizá-lo pelo conteúdo do site que agregou muito conhecimento para min. O código acima é parecido com que eu preciso, porem como trabalho com tabelas vinculadas via odbc. Gostaria se saber se seria teria uma código parecido com esse em questão só que iria buscar na fonte de dados odbc a fonte que eu especificar e consequentemente eu especificaria a tabela também. Por que preciso especificar? Porque são muitas fontes odbc e centenas de tabelas. Certo da atenção agradeço e aguardo retorno. Victor Marques |