[Resolvido]Função para mudar senha e vincular tabelas sem alterar os relacionamentos, alguem sabe?

Olá Amigos do forum,

tenho uma função para mudar senha e vincular tabelas só que após a execução ela altera os relacionamentos, ou tira os relacionamentos das tabelas, no menu relacionamentos,

alguem tem alguma experiencia, se tem como executar a função para refazer os vinculos das tabelas e mudar a senha sem mexer nos relacionamentos?

a função que eu uso é esta

Código:


Function ReVincularTabelas(strcaminho As String, senha As String)
On Error GoTo y1:
Dim Dbs As Database
Dim dbfront, conect
Dim Tdf As TableDef
Dim Tdfs As TableDefs, Conttdf As Integer, StatusTexto
Set Dbs = CurrentDb
Set Tdfs = Dbs.TableDefs

Set Dbs = DBEngine(0)(0)
    Conttdf = 1 ' Ajusta contador de tabelas = 1
DoCmd.Hourglass True
    ' Inicia a barra de progresso do Access.
    StatusTexto = "Atualizando vínculos com " & strcaminho & "..."
    SysCmd acSysCmdInitMeter, StatusTexto, Dbs.TableDefs.Count
  If IsNull(senha) Or senha = "" Then
    conect = ";Database=" & strcaminho
  Else
    conect = ";Database=" & strcaminho & ";Pwd=" & Nz(senha)
  End If
 
 For Each Tdf In Tdfs
 If Tdf.SourceTableName <> "" Then
  'SysCmd acSysCmdInitMeter, StatusTexto, Dbs.TableDefs.Count
  SysCmd acSysCmdUpdateMeter, Conttdf 'Atualiza o progresso.
  Conttdf = Conttdf + 1:
  Tdf.Connect = conect
  Tdf.RefreshLink: 'Forms!aviso.Requery
End If
Next
SysCmd acSysCmdRemoveMeter
DoCmd.Hourglass False
ReVincularTabelas = True
Exit Function
y1: SysCmd acSysCmdRemoveMeter: DoCmd.Hourglass False: MsgBox Err.Description:
 ReVincularTabelas = False:
End Function


desde já agradeço

Algum avanço aqui?

Já consegui resolver

Obrigado DamascenoJr.