[Resolvido]Iniciar o access com um código

Precisava que o access arrancasse com um código.
Tenho o programa a arrancar com uma macro que faz correr o código e abre um form.
o código vai procurar vínculos nas tabelas. Se encontra dá uma mensagem "Erro nº 13 Type Mismatch.
Se não encontra corre normalmente, em busca da bd com as tabelas.
Verifiquei o código, do módulo, e confirmei que tem o tratamento de erro.
Pesei em testar a abertura da bd com com código, que testa os vínculos, mas só sei com macros.

Luís Antunes

Para além de macro, pode fazer ainda de outra forma;

Manda abrir um form em modo oculto, em que no evento ao abrir chame a função;

Código:


Private Sub Form_Open(Cancel As Integer)
    Call SuaFuncao
End Sub

J Paulo

Já fiz o que sugeriu Criei um form e no open inseri o "Call função"
Como o erro persiste, logo o problema vem da função ChecaVinculos.
Quando corro a compilação não encontra nenhum erro.
Podem me dar uma ajuda com tratamento de erro desta função?

Luís Antunes



Function ChecaVinculo(strNomesTab As String) As Boolean
' Autor: João Rodrigues
' E-mail: accessjr@bol.com.br
' Data: Maio/99
' Função que checa o vínculo da tabela strNomesTab.
' Retorna True ou False, dependendo do vínculo
' estar correto, ou não.
On Error GoTo ChecaVinculo_Err
Dim db As Database, fld As Field, prp As Property

Set db = DBEngine(0)(0)
ChecaVinculo = False 'Inicializa a função.

'Tenta obter um campo da tabela vinculada strNomesTab.
'Se der erro, é preciso revincular as tabelas.
Set fld = db.TableDefs(strNomesTab).Fields(0)
'Se chegou aqui é porque o vínculo é válido.
ChecaVinculo = True

ChecaVinculo_Sai:
Set db = Nothing 'libera memória.
Set fld = Nothing: Set prp = Nothing
Exit Function

Tenta_Vincular:
MsgBox "Não foi possível abrir o arquivo" & vbCrLf _
& "que contém as tabelas com os dados." _
& vbCrLf & vbCrLf _
& "Por favor, selecione um arquivo com os dados.", _
vbInformation, "Informação"
' Abre o form frmMudaBackEnd, para que o usuário
' selecione o MDB contendo as tabelas com os dados
' na caixa de diálogo padrão "Abrir Arquivo" do Windows.
DoCmd.OpenForm "frmMudaBackEnd", windowmode:=acDialog, _

OpenArgs:=True
'O frmMudaBackEnd irá definir o valor de fSucesso.
ChecaVinculo = fSucesso
GoTo ChecaVinculo_Sai

ChecaVinculo_Err:
Select Case Err.Number
Case 3024, 3043, 3044, 3265
'Não é um caminho válido, ou arq não encontrado.
GoTo Tenta_Vincular
Case Else
Call InformaErro
End Select
Resume ChecaVinculo_Sai

End Function

função corrigida, teste por favor;

Código:

Function ChecaVinculo(strNomesTab As String) As Boolean
' Autor: João Rodrigues
' E-mail: accessjr@bol.com.br
' Data: Maio/99
' Função que checa o vínculo da tabela strNomesTab.
' Retorna True ou False, dependendo do vínculo
' estar correto, ou não.
On Error GoTo ChecaVinculo_Err
Dim db As Database, fld As Field, prp As Property

Set db = DBEngine(0)(0)
ChecaVinculo = False 'Inicializa a função.

'Tenta obter um campo da tabela vinculada strNomesTab.
'Se der erro, é preciso revincular as tabelas.
Set fld = db.TableDefs(strNomesTab).Fields(0)
'Se chegou aqui é porque o vínculo é válido.
ChecaVinculo = True

ChecaVinculo_Sai:
Set db = Nothing 'libera memória.
Set fld = Nothing: Set prp = Nothing
Exit Function

Tenta_Vincular:
MsgBox "Não foi possível abrir o arquivo" & vbCrLf _
& "que contém as tabelas com os dados." _
& vbCrLf & vbCrLf _
& "Por favor, selecione um arquivo com os dados.", _
vbInformation, "Informação"
' Abre o form frmMudaBackEnd, para que o usuário
' selecione o MDB contendo as tabelas com os dados
' na caixa de diálogo padrão "Abrir Arquivo" do Windows.
DoCmd.OpenForm "frmMudaBackEnd", windowmode:=acDialog, OpenArgs:=True
'O frmMudaBackEnd irá definir o valor de fSucesso.
ChecaVinculo = fSucesso
GoTo ChecaVinculo_Sai

ChecaVinculo_Err:
Select Case Err.Number
Case 3024, 3043, 3044, 3265
'Não é um caminho válido, ou arq não encontrado.
GoTo Tenta_Vincular
Case Else
Dim Msg$
    DoCmd.Hourglass False
    DoCmd.Echo True
Msg = "Erro # " & Str(Err.Number) & " gerado na " & Err.Source _
        & vbNewLine & vbNewLine & "Descrição: " & Err.Description _
        & vbNewLine & vbNewLine & "Por favor contate o Administrador do Sistema."
    MsgBox Msg, vbMsgBoxHelpButton + vbCritical, "Erro", Err.HelpFile, Err.HelpContext
End Select
Resume ChecaVinculo_Sai
End Function

J Paulo
Testei o código corrigido e dá-me outro tipo de erro:
"Erro nº 13 Gerado na BD
Discrição Type Mitsmatch
Por favor contacte com o administador"

Luís Antunes

PS:
Como é que ponho o código dentro da caixa?

Dentro da caixa ?

Você tem de chamar a função assim;

Código:

Call ChecaVinculo("SuaTabela")

Para si o mais facil é assim;

Código:

Public Sub RelinkTabelas(DiretorioBanco As String)
    Dim Dbs As Database
    Dim Tdf As TableDef
    Dim Tdfs As TableDefs
    Set Dbs = CurrentDb
    Set Tdfs = Dbs.TableDefs
       For Each Tdf In Tdfs
        If Tdf.SourceTableName <> "" Then
            Tdf.Connect = ";DATABASE=" & DiretorioBanco
            Tdf.RefreshLink
        End If
    Next
End Sub

Na abertura do form oculto, você chama o sub;

Código:

Call RelinkTabelas("C:\BancoExterno.accdb")

J Paulo
Pus o código num módulo e o call no form de abertura com o repetivo caminho para be
dá a mesma mensagem de erro.

Luís Antunes

PS:
A Caixa é onde o Paulo coloca o código

J Paulo
Já consegui tirar o erro do código
fiz uma MsgBox antes de cada comando, e detectei o código que dava o erro.
fiz o tratamento de erro e resultou.

Luís Antunes


On Error GoTo Err
'Tenta obter um campo da tabela vinculada strNomesTab.
'Se der erro, é preciso revincular as tabelas.
Set fld = db.TableDefs(strNomesTab).Fields(0)
'Se chegou aqui é porque o vínculo é válido.
ChecaVinculo = True
Err:

J Paulo
Já consegui tirar o erro do código
fiz uma MsgBox antes de cada comando, e detectei o código que dava o erro.
fiz o tratamento de erro e resultou.

Luís Antunes


On Error GoTo Err
'Tenta obter um campo da tabela vinculada strNomesTab.
'Se der erro, é preciso revincular as tabelas.
Set fld = db.TableDefs(strNomesTab).Fields(0)
'Se chegou aqui é porque o vínculo é válido.
ChecaVinculo = True
Err:

Obrigado pelo retorno.