[Resolvido]Erro de fonte confiável

Pessoal preciso de uma ajuda, meu sistema é usado em servidor... e quando outro usuário tenta abrir o arquivo aparece a mensagem na imagem abaixo, alguém poderia me ajudar?
Lembrando que já deixei o caminho da pasta onde está armazenado o arquivo como Confiável e Habilitei todas macros.

Olá Caio,

Com uma busca aqui do fórum por vezes tem o que pretendemos, veja como fazer:
https://www.maximoaccess.com/t1115-busca-no-forum-search

Veja abaixo se não é o que pretende (tem lá um link do colega Avelino Sampaio que explica tudo):
https://www.maximoaccess.com/t6962-resolvidocomo-evitar-o-aviso-de-seguranca-com-a-mensagem-voce-deseja-abrir-este-banco-de-dados

Abraço

Tentei e dá um erro na parte em vermelha.

Option Compare Database
Option Explicit

Dim CaminhoLoc As String
'--------------------------------------------------------------------------
Public Function fncConfigMacro()
Dim reg As Object
On Error Resume Next
'------------------------------------------------------------
'Se encontrar uma das configurações já feitas, abortar função.
'------------------------------------------------------------
If fncJaConfigurado Then Exit Function
'------------------------------------------------------------

Set reg = CreateObject("wscript.shell")
'------------------------------------------------------------
'Configurando como confiável a pasta aonde se encontra seu BD
'------------------------------------------------------------
reg.RegWrite CaminhoLoc & "AllowSubfolders", 1, "REG_DWORD"
reg.RegWrite CaminhoLoc & "Date", Date, "REG_SZ"
reg.RegWrite CaminhoLoc & "Description", "Projeto exemplo", "REG_SZ"
reg.RegWrite CaminhoLoc & "Path", fncLocalBd, "REG_SZ"

Set reg = Nothing
End Function

'--------------------------------------------------------------------------
Public Function fncLocalBd() As String
On Error Resume Next
'-----------------------------------------------
'Localiza a pasta do Banco de Dados em execução
'-----------------------------------------------
fncLocalBd = Application.CurrentProject.Path
End Function

'--------------------------------------------------------------------------
Private Function fncJaConfigurado() As Boolean
Dim reg As Object
Dim CaminhoGravado As String

Set reg = CreateObject("wscript.shell")
fncJaConfigurado = False
On Error Resume Next

'---------------------------------------
'Captura o caminho da pasta no registro
'---------------------------------------
CaminhoGravado = reg.RegRead(CaminhoLoc & "\path")
'------------------------------------------------------------
'Compara o caminho da pasta do registro com o caminho atual
'------------------------------------------------------------
If CaminhoGravado = fncLocalBd Then fncJaConfigurado = True
Set reg = Nothing
End Function

'--------------------------------------------------------------------------
Private Function fncCaminhoLoc() As String
Dim caminho As String
Dim nomeBd As String

'-------------------------------------------------------
'Captura o nome do seu aplicativo para cria o nome da
'pasta no trusted locations
'-------------------------------------------------------
nomeBd = CurrentProject.Name
nomeBd = Mid(nomeBd, 1, InStr(nomeBd, ".accd") - 1)

'--------------------------------------------------------------
'Monta caminho do registro em função da verão atual do Access
'e do nome do seu aplicativo
'--------------------------------------------------------------
caminho = Replace("HKEY_CURRENT_USER\Software\Microsoft\Office _
\[v]\Access\Security\Trusted Locations\[bd]\", "[v]", Application.Version)

caminho = Replace(caminho, "[bd]", nomeBd)

'------------------------------------------
'Passa o caminho do registro para a função
'------------------------------------------
fncCaminhoLoc = caminho
End Function



E na Macro?
Uso Access 2010 e só tenho a opção de chamar a função. No exemplo dele exige a Condição.

Olá, no site do colega Avelino Sampaio tem exemplo para baixar (tuto5.zip).
Baixe e teste com o exemplo.
Abraço

Olá,

Baixei e dá o mesmo erro, creio que seja por causa da versão do Access. Uso o 2010.

Olá, partilhe foto do erro que esta a dar no código.
Abraço

Segue...

E o Locations fica selecionado.

Olá Caio, acho que não baixou o exemplo e verificou o código.
Acabei de baixar e verificar, veja e compare com o seu:

Código:

   '-----------------------------------------------------------------------------------------
    'Monta caminho do registro em função da verão atual do Access e do nome do seu aplicativo
    '-----------------------------------------------------------------------------------------
    caminho = Replace("HKEY_CURRENT_USER\Software\Microsoft\Office\[v]\Access\Security\Trusted Locations\[bd]\", "[v]", Application.Version)
    caminho = Replace(caminho, "[bd]", nomeBd)

Abraço

Não está funcionando...

Nessa parte eu tenho que especificar o endereço do meu arquivo ou o nome?
caminho = Replace(caminho, "]bd]", nomeBd)


Outra dúvida é, na Macro do mestre Avelino ele especifica a condição CurrentProject.isTrusted=-1, porém no 2010 só consigo especificar o nome da função.

Sobre a macro, consegui fazer com que execute a função fncConfigMacro() se for encontrado a propriedade CurrentProject.isTrusted=-1.

Porém mesmo assim não está funcionando, lembrando que a mensagem que me aparece é a de Runtime.

Olá Caio, respondendo à mensagem nº 9:

Neste parte

Código:

caminho = Replace(caminho, "[bd]", nomeBd)

é mesmo assim, não precisa de alterar nada.

Já compilou o seu projecto, não apresenta erros?

O exemplo do colega Avelino Sampaio está a funcionar.
Baixe de novo e teste numa pasta nova, pode ser "C:\TesteAvelino" e verifique se funciona ou não.
A informação também é clara, tente estudar melhor.

Se a situação se mantiver, terá que postar o seu arquivo para podermos testar.
Abraço

Resolvido!

Olá Caio, vejo que resolveu!
Pode partilhar onde estava o problema.
Assim pode ser ajuda para outros membros.
Abraço

Boa tarde,
Segue Módulo:

Código:

Option Compare Database
Option Explicit

Dim CaminhoLoc As String

Public Function fncConfigMacro()
Dim reg As Object

On Error Resume Next
'----------------------------------------
'Se já foi configurado, abortar função.
'----------------------------------------
If fncJaConfigurado Then Exit Function
'------------------------------------------------------------

CaminhoLoc = fncCaminhoLoc
Set reg = CreateObject("wscript.shell")
'--------------------------------------------------------
'Configurando pasta confiável aonde se encontra seu BD
'--------------------------------------------------------
reg.regWrite CaminhoLoc & "AllowSubfolders", 1, "REG_DWORD"
reg.regWrite CaminhoLoc & "Date", Date, "REG_SZ"
reg.regWrite CaminhoLoc & "Description", "Projeto exemplo", "REG_SZ"
reg.regWrite CaminhoLoc & "Path", fncLocalBd, "REG_SZ"
'-----------------------
'libera pasta de rede
'-----------------------
reg.regWrite fncCaminhoLoc(True) & "AllowNetworkLocations", 1, "REG_DWORD"

Set reg = Nothing
End Function

Public Function fncLocalBd() As String
On Error Resume Next
'-----------------------------------------------
'Localiza a pasta do Banco de Dados em execução
'-----------------------------------------------
fncLocalBd = Application.CurrentProject.Path
End Function

Private Function fncJaConfigurado() As Boolean
Dim reg As Object
Dim CaminhoGravado As String

CaminhoLoc = fncCaminhoLoc
Set reg = CreateObject("wscript.shell")
fncJaConfigurado = False
On Error Resume Next
'---------------------------------------
'Captura o caminho da pasta no registro
'---------------------------------------
CaminhoGravado = reg.RegRead(CaminhoLoc & "\path")

'-----------------------------------------------------------
'Compara o caminho da pasta do registro com o caminho atual
'-----------------------------------------------------------
If CaminhoGravado = fncLocalBd Then fncJaConfigurado = True
Set reg = Nothing
End Function

Public Function fncCaminhoLoc(Optional rede As Boolean = False) As String
Dim caminho As String
Dim nomeBd As String

'-----------------------------------------------------------------------------
'Captura o nome do seu aplicativo para cria nome da pasta no trusted locations
'-----------------------------------------------------------------------------
nomeBd = Application.CurrentProject.Name
nomeBd = Mid(nomeBd, 1, InStr(nomeBd, ".accd") - 1)
If rede Then
    '--------------------------------
    'caminho que libera pasta de rede
    '--------------------------------
    caminho = Replace("HKEY_CURRENT_USER\Software\Microsoft\Office\[v]\Access\Security\Trusted Locations\", "[v]", Application.Version)
Else
    '-----------------------------------------------------------------------------------------
    'Monta caminho do registro em função da verão atual do Access e do nome do seu aplicativo
    '-----------------------------------------------------------------------------------------
    caminho = Replace("HKEY_CURRENT_USER\Software\Microsoft\Office\[v]\Access\Security\Trusted Locations\[bd]\", "[v]", Application.Version)
    caminho = Replace(caminho, "[bd]", nomeBd)
End If
'------------------------------------------
'Passa o caminho do registro para a função
'------------------------------------------
fncCaminhoLoc = caminho
End Function


E na Macro:

Nome da macro "AutoExec"

Se [currentproject].[istrusted]=True..............................Então
ExecutarCódigo
Nome da função =fncConfigMacro()

Lembrando que o formulário principal que abrirá junto ao sistema tem que ser especificado Em Arquivo>Opções>Banco de dados atual>Formulário de Exibição.