MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

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

    Compartilhe

    Clebergyn
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 691
    Registrado : 29/08/2012

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

    Mensagem  Clebergyn em Sab 23 Jun 2018, 11:42 pm

    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


      Data/hora atual: Seg 19 Nov 2018, 3:37 am