[Resolvido]Anexar ficheiros a registos em pasta externa ao BD

Bom dia Prezados Mestes

Estou há algum tempo a tentar adaptar alguns dos exemplos do site ao meu caso concreto, mas estou com dificuldade e precisava da vossa ajuda.
Então no formulário “novo projeto”, no subformulário “anexos” tenho 3 botões dois deles funcionam como pretendo mas o do meio (define o local do anexo) que seria suposto, abrir a janela do sistema para selecionar o ficheiro a anexar, mover esse ficheiro para a pasta “Anexos” que ficará na mesma localização do BE da BD e guardar o caminho do ficheiro na tabela “ANEXOS” não estou a conseguir fazer isso, da sempre erro.
Estou a trabalhos no office 365 (64 bits) e Windows 2010 (64 bits).
Agradecia muito a vossa ajuda (anexo o Bd, sem BE), muito Obrigado

Olá

Nesse botão que diz não funcionar;

Código:

Private Sub btDefinirLocal_Click()

  On Error GoTo btDefinirLocal_Click_Error


    If IsNull(Me.AnNome) Then
            'Solicita um nome para o anexo antes de definir o local
        MsgBox "Primeiro defina um nome para descrever o anexo", _
        vbExclamation + vbOKOnly + vbDefaultButton1, "Dados faltando"
        Me.AnNome.SetFocus
        Exit Sub
    End If
   
'*************************************************************************
Dim strFicheiro As Object
Dim varFicheiro As Variant
Dim strFicheiro2 As Variant

    Set strFicheiro = Application.FileDialog(3)
    strFicheiro.Title = "Selecione o nome do arquivo"
    strFicheiro.Filters.Add "All Files", "*.*"
    strFicheiro.FilterIndex = 1
    strFicheiro.AllowMultiSelect = False
    strFicheiro.InitialFileName = "C:\"
    strFicheiro.Show
   
        For Each varFicheiro In strFicheiro.SelectedItems
              strFicheiro2 = varFicheiro
        Next
       
    If IsNull(strFicheiro2) Or strFicheiro2 = "" Then
      'não faz nada
        Else
        Me.Caminho.Value = strFicheiro2
    End If
   
'*************************************************************************
  On Error GoTo 0
  Exit Sub

btDefinirLocal_Click_Error:

 
  MsgBox "ERRO " & Err.Number & " - (" & Err.Description & ")"
End Sub

Boa tarde João Paulo

És uma maquina!!!
Muito Obrigado
Top era isto mesmo

Obrigado pelo retorno o forum agradece.

Boas João Paulo

Afinal apos mais uns testes detetei que não ficou exatamente como eu pretendia, faltou ele mover o anexo para a pasta onde devem ficar os anexos e deve mudar o nome do ficheiro de forma a conseguir posteriormente abrir o(s) correspondentes a cada registo(projeto).
No meu caso cada trabalho tem um email de pedido, e depois varios emails pelo meio ate conclusão e um email final.
O que eu pretendo é ao entrar na folha de registo do trabalho poder consultar o pedidos e os restantes emails, sem ter de os guardar na BD que isso esta a trazer problemas com a dimensão da mesma.(no form anexos tem 3 botões um, para excluir anexos, outro para ver cada um dos anexos e um para colocar os anexos.
Da forma como me envias-te, tenho de colocar o anexo diretamente na pasta e linkar ao formulário, mas assim não consegue distinguir os varios anexos do mesmo projeto.
parece-me que o ideal seria mover o ficheiro para a pasta anexos na mesma localização do BD e nomear com o ID do projeto e do anexo, e guardar esse caminho para este novo ficheiro na tabela anexos.
Será possivel? não sei se me fiz entender.

desculpa pelo incomodo.

Olá Jorge

Veja o simples;

Código:

Private Sub btDefinirLocal_Click()
 On Error GoTo btDefinirLocal_Click_Error

    If IsNull(Me.AnNome) Then
            'Solicita um nome para o anexo antes de definir o local
        MsgBox "Primeiro defina um nome para descrever o anexo", _
        vbExclamation + vbOKOnly + vbDefaultButton1, "Dados faltando"
        Me.AnNome.SetFocus
        Exit Sub
    End If
    
'*************************************************************************
Dim strFicheiro As Object
Dim varFicheiro As Variant
Dim strFicheiro2 As Variant
Dim GetFicheiroExt As Variant
    Set strFicheiro = Application.FileDialog(3)
    strFicheiro.Title = "Selecione o nome do arquivo"
    strFicheiro.Filters.Add "All Files", "*.*"
    strFicheiro.FilterIndex = 1
    strFicheiro.AllowMultiSelect = False
    strFicheiro.InitialFileName = "C:\"
    strFicheiro.Show
    
         For Each varFicheiro In strFicheiro.SelectedItems
               strFicheiro2 = varFicheiro
         Next
        
    If IsNull(strFicheiro2) Or strFicheiro2 = "" Then
       'não faz nada
       Exit Sub
        Else
        'obtem a extensão do ficheiro
        GetFicheiroExt = Right(strFicheiro2, Len(strFicheiro2) - InStrRev(strFicheiro2, "."))
        'move o ficheiro para a pasta Anexos e renomeia o ficheiro
        Name strFicheiro2 As CurrentProject.Path & "\Anexos\" & Me.IDproj & "_" & Me.IdAnexo & "." & GetFicheiroExt
        'deposita o novo caminho no campo da tabela
        Me.Caminho.Value = CurrentProject.Path & "\Anexos\" & Me.IDproj & "_" & Me.IdAnexo & "." & GetFicheiroExt
    End If
    
Me.Requery
'*************************************************************************
   On Error GoTo 0
   Exit Sub

btDefinirLocal_Click_Error:

  
   MsgBox "ERRO " & Err.Number & " - (" & Err.Description & ")"
End Sub

Bom dia Mais uma vez

O problema agora é que quando mudo de um trabalho para outro não atualiza, o Id do trabalho no subform anexos e por isso não consegue anexar corretamente, já tentei de varias formas mas não estou a conseguir.
Anexo o Bd para ver se consegue ajudar.
Obrigado e desculpa incomodar.

Isso agora é modelagem de dados.

Você está a inventar e assim não funciona mesmo, você adicionou oldname e newname e nem declarou as variaveis.
Para além disso Me.AID não existe.
Ainda para além disso, o subform Anexos não tem ligação ao form;

Eu não trabalho em programação desse jeito, não leve a mal, mas gosto de ajudar para que as pessoas possam aprender e evoluír.

Boa tarde

Antes de mais as minhas desculpas pela "bagunça". Como estou a trabalhar noutras coisas em simultâneo e como estava a usar um modelo sem dados para conseguir anexar e a tentar por a coisa a funcionar no FE da BD original esqueci-me de alterar alguns nomes que são ligeiramente diferentes e de associar os forms por isso é que não estava a funcionar, parece-me que com as suas dicas ja consegui, vou testar melhor tudo e se precisar mais alguma ajuda digo.

Peço mais uma vez desculpas e muito obrigado

Obrigado pelo retorno o forum agradece.