[Resolvido]Copiar entre bases de dados

Como posso copiar um registo de um formulário de uma base de dados para outro formulário de outra base de dados sem ligação de tabelas?

Por exemplo, numa base de dados tenho num formulário o registo actual faço clique num botão ele abre outra base de dados, abre o formulário que quero vai para registo novo e copia os dados para esse formulário nos campos correspondentes.

Veja o arquivo em anexo e adapte-o ao seu cenário.

Código utilizado no botão btCopiar

Código:

Dim app                  As Access.Application
    Dim strCaminhoAppDestino As String
    Dim objws                As Object
    Dim varStart
   
    If Nz(Me!txtNome.Value) = "" Then
        MsgBox "Insira o nome.", vbExclamation, "Atenção"
        Me!txtNome.SetFocus
        Exit Sub
    ElseIf Nz(Me!txtSobrenome.Value) = "" Then
        MsgBox "Insira o sobrenome.", vbExclamation, "Atenção"
        Me!txtSobrenome.SetFocus
        Exit Sub
    End If
   
    strCaminhoAppDestino = CurrentProject.Path & "\Database2.accdb"
   
    If Nz(Dir(strCaminhoAppDestino)) = "" Then
        MsgBox "Aplicativo de destino não se encontra na mesma pasta do aplicativo atual.", vbExclamation, "Atenção"
        Exit Sub
    End If
   
    Set objws = CreateObject("wscript.shell")
    objws.Run """" & SysCmd(acSysCmdAccessDir) & "\msaccess.exe"" """ & strCaminhoAppDestino & """", 5, "false"
    Set objws = Nothing
   
    varStart = Timer
    Do While Timer < varStart + (2000 / 1000)
        DoEvents
    Loop
   
    Set app = GetObject(strCaminhoAppDestino)
    app.DoCmd.OpenForm "Formulário1", , , , acFormAdd
    With app.Forms("Formulário1")
        !txtNome.Value = Me!txtNome.Value
        !txtSobrenome.Value = Me!txtSobrenome.Value
    End With
    Set app = Nothing

Olá a todos,

Nuno, outra alternativa simles ao exemplo do colega Ivan, pode ser uma simples consulta SQL.

Podemos ter uma instrução SQL já a filtrar o registo usando a calusula IN
... IN 'caminho\suaBaseDados.accdb' ...

Veja tópicos:
https://www.maximoaccess.com/t32571-resolvidoinsert-into-entre-bancos-access-destintos
https://www.maximoaccess.com/t25463-resolvidoerro-no-insert-into

Abraço a todos

Alvaro, mas isso já gravaria o registro na outra base de dados. Pela dúvida do usuário Nuno (apontando que os dados sejam copiados entre formulários), eu supus que a nova BD tenha apenas alguns campos similares ao antigo mas que necessite do preenchimento de outros campos antes do registro ser de fato gravado na base.

Uma duvida, porque o código abre duas vezes a Database2??

Se você clicou duas vezes o arquivo vai abrir duas vezes.

O código foi bem simples apenas para mostrar-lhe como. Não cheguei a imaginar as diversas situações como, por exemplo, verificar se o Database2 já está previamente aberto de forma manual ou por outra operação, se o usuário já estava com a tela do formulário no Database2 aberta só que em outro registro o que poderia dar problema, e tantas outras situações...

A ideia foi mostrar-lhe o caminho. Cubra as situações conforme seu cenário e necessidade fazendo adaptações.

Adaptei e funciona na perfeição o único problema foi o que disse na outra mensagem
Faço clique uma vez e abre a bd 2 duas vezes.

O código adaptado ficou:

Código:

Private Sub Comando81_Click()
    Dim app                  As Access.Application
    Dim strCaminhoAppDestino As String
    Dim objws                As Object
    Dim varStart
   
    strCaminhoAppDestino = CurrentProject.Path & "\MAPAS FIM MÊS\Base de Dados Dispositivo (2014) - Alterada.mdb"
   
    If Nz(Dir(strCaminhoAppDestino)) = "" Then
        MsgBox "Aplicativo de destino não se encontra na mesma pasta do aplicativo atual.", vbExclamation, "Atenção"
        Exit Sub
    End If
   
    Set objws = CreateObject("wscript.shell")
    objws.Run """" & SysCmd(acSysCmdAccessDir) & "\msaccess.exe"" """ & strCaminhoAppDestino & """", 5, "false"
    Set objws = Nothing
   
    varStart = Timer
    Do While Timer < varStart + (2000 / 1000)
        DoEvents
    Loop
   
    Set app = GetObject(strCaminhoAppDestino)
    app.DoCmd.OpenForm "SIM - censurado"
    app.DoCmd.OpenForm "censurado", , , , acFormAdd
    With app.Forms("censurado")
        !nuipc.Value = Me!nuipc.Value
        ![Data].Value = Me![Data].Value
        ![Texto58].Value = Me![Texto58].Value
        ![Modo contacto vitima].Value = Me![Modo contacto vitima].Value
        ![fizeram-se passar por].Value = Me![fizeram-se passar por].Value
        !modus_operandi.Value = Me!modus_operandi.Value
        !Distrito.Value = Me!Distrito.Value
        !Concelho.Value = Me!Concelho.Value
        ![lugar/freguesia].Value = Me![lugar/freguesia].Value
        ![objecto censurado].Value = Me![objecto censurado].Value
        ![Valor].Value = Me![Valor].Value
        ![nº autores].Value = Me![nº autores].Value
        !CaixaCombinação60.Value = Me!CaixaCombinação60.Value
        ![descrição ocorrência].Value = Me![descrição ocorrência].Value
        !latitude.Value = Me!latitude.Value
        !longitude.Value = Me!longitude.Value
    If [censurado]![idade vitima].Value <> "" Then
        !censurado![tipo vitima].Value = [censurado]![tipo vitima].Value
        !censurado![idade vitima].Value = [censurado]![idade vitima].Value
        !censurado![Sexo].Value = [censurado]![Sexo].Value
        !censurado![local onde foi censurado].Value = [censurado]![local onde foi censurado].Value
        !censurado![nome (se colectiva)].Value = [censurado]![nome (se colectiva)].Value
    End If
    If [censurado]![idade].Value <> "" Then
        !censurado![Nome].Value = [censurado]![Nome].Value
        !censurado![idade].Value = [censurado]![idade].Value
        !censurado![Sexo].Value = [censurado]![Sexo].Value
        !censurado![nacionalidade].Value = [censurado]![nacionalidade].Value
        !censurado![Profissão].Value = [censurado]![Profissão].Value
        !censurado![medida coação aplicada].Value = [censurado]![medida coação aplicada].Value
    End If
    If [censurado]![matrícula].Value <> "" Then
        !censurado![tipo viatura].Value = [censurado]![tipo viatura].Value
        !censurado![matrícula].Value = [censurado]![matrícula].Value
        !censurado![marca].Value = [censurado]![marca].Value
        !censurado![modelo].Value = [censurado]![modelo].Value
        !censurado![cor].Value = [censurado]![cor].Value
    End If
    End With
    Set app = Nothing

End Sub

Olá a todos,

Ivan, podemos ter vários "caminhos" para o mesmo destino (objetivo).
Foi apenas uma sugestão, o nosso colega Nuno que abriu o tópico é que poderá dizer qual o caminho mais adequado.

Parece que vai pela sua sugestão.

Abraço a todos

Obrigado na mesma Alvaro Teixeira mas há campos que não são copiados é por isso que não aplico a sua forma.

Nuno, fiquei confuso, no código só há uma chamada para abertura do outro arquivo.

Anexe um arquivo com os objetos envolvidos para que possamos investigar.

Não é necessário anexar, podes testar no teu exemplo que acontece o mesmo.
Na primeira vez funcionou, fechei tudo e voltei a abrir então começou a dar esse problema.
Abre duas vezes a bd 2 quando carrego no botão para fazer a exportação.

Testei diversas vezes aqui e em todas só abre uma vez. Aguardemos outros usuários que possam ajudar e ver o que não estamos vendo. Sucesso.

Ok deve ser um problema com o meu office.
Na segunda eu tento noutro pc.

Obrigado. Dou por resolvido.