[Resolvido]Copiar nome de ficheiro para tabela

Olá

Tenho uma BD com duas tabelas, Avarias e AnexoAvarias e um formulário, Avarias.
Estou a tentar copiar o nome de um ficheiro para a tabela AnexoAvarias com o seguinte código

Código:

Private Sub Rótulo50_Click()

Dim f    As Object
Dim varFile As Variant
Dim db As Database
Dim tb As Recordset
Dim name As String

Set f = Application.FileDialog(3)

 f.AllowMultiSelect = True
 f.Filters.Clear
 f.Filters.Add "Ficheiros PDF", "*.pdf"
 f.Filters.Add "Ficheiros Excel", "*.xlsx"
 f.Filters.Add "Ficheiros Excel 2003", "*.xls"
 f.Filters.Add "Ficheiros Word", "*.docx"
 f.Filters.Add "Ficheiros Word 2003", "*.doc"
 f.Filters.Add "All Files", "*.*"
 
 Set db = CurrentDb
 Set tb = db.OpenRecordset("AnexosAvarias")
 
 If f.Show = True Then
 
        For Each varFile In f.SelectedItems
       
            name = Mid(varFile, 1 + InStrRev(varFile, "\"))
            FileCopy varFile, CurrentProject.Path & "\files\" & name
            tb.AddNew
            tb!Nome = name
            tb.Update
           
        Next
       
            tb.Close
            Set db = Nothing
End If

End Sub

Consigo copiar o ficheiro par a respectiva pasta e o nome para a tabela no entanto esse nome/ficheiro não fica relaccionado com o registo que estou a trabalhar (existe uma relação 1 para muitos entre a tabela Avarias e AnexoAvarias) e também não consigo listar o ficheiro na Listbox do formulário.

Alguém me pode ajudar?

Em anexo coloquei a BD.

Falta o ADD do numero do incidente, para se relacionarem;

E tambem já abre o ficheiro com duplo click na listbox;

http://dl.dropbox.com/u/771097/BDFile_OLD.rar

Private Sub Rótulo50_Click()
Dim f    As Object
Dim varFile As Variant
Dim db As Database
Dim tb As Recordset
Dim name As String

Set f = Application.FileDialog(3)

        f.AllowMultiSelect = True
        f.Filters.Clear
        f.Filters.Add "Ficheiros PDF", "*.pdf"
        f.Filters.Add "Ficheiros Excel", "*.xlsx"
        f.Filters.Add "Ficheiros Excel 2003", "*.xls"
        f.Filters.Add "Ficheiros Word", "*.docx"
        f.Filters.Add "Ficheiros Word 2003", "*.doc"
        f.Filters.Add "All Files", "*.*"
 
 Set db = CurrentDb
 Set tb = db.OpenRecordset("AnexosAvarias")
 
 If f.Show = True Then
 
        For Each varFile In f.SelectedItems
        
            name = Mid(varFile, 1 + InStrRev(varFile, "\"))
            FileCopy varFile, CurrentProject.Path & "\files\" & name
            tb.AddNew
            tb!Nome = name
            tb!Incidente = Me.Incidente.Value
            tb.Update
            
        Next
        
            tb.Close
            Set db = Nothing
End If
Me.Refresh
End Sub

Olá,

Pois faltava.
Eu reparei nisso mas estava a pensar de forma errada e por isso não experimentei.

Em relação ao duplo click para abrir o ficheiro, estava mesmo a pensar nisso.

Muito obrigado.

Obrigado pelo retorno, o fórum agradece.

Reabri o tópico porque ao utilizar a versão final do código aqui colocado o utilizador consegue inserir ficheiros com o mesmo nome e ao copiar o ficheiro o existente é substituído pelo novo. Eu queria impedir isso comparando o nome do ficheiro (guardado na variável "name") com os nomes guardados no campo "Nome" da tabela AnexosAvarias e para isso utilizei a função Dlookup, mas não estou a conseguir, dever faltar alguma (muita) coisa,

Código:


Private Sub btnInserir_Click()
Dim f    As Object
Dim varFile As Variant
Dim db As Database
Dim tb As Recordset
Dim name As String

Set f = Application.FileDialog(3)

        f.AllowMultiSelect = True
        f.Filters.Clear
        f.Filters.Add "Ficheiros PDF", "*.pdf"
        f.Filters.Add "Ficheiros Excel", "*.xlsx"
        f.Filters.Add "Ficheiros Excel 2003", "*.xls"
        f.Filters.Add "Ficheiros Word", "*.docx"
        f.Filters.Add "Ficheiros Word 2003", "*.doc"
        f.Filters.Add "All Files", "*.*"
 
 Set db = CurrentDb
 Set tb = db.OpenRecordset("AnexosAvarias")
 
 If f.Show = True Then
 
        For Each varFile In f.SelectedItems
       
            name = Mid(varFile, 1 + InStrRev(varFile, "\"))
           
            If (DLookup("[Nome]", "AnexosAvarias", "[Nome]=" & name & "")) <> Null Then
           
            MsgBox "Ficheiro já existente", vbExclamation
                       
            Else
           
            FileCopy varFile, CurrentProject.Path & "\files\" & name
            tb.AddNew
            tb!Nome = name
            tb!Incidente = Me.Incidente.Value
            tb.Update
           
                 
            End If
           
              Next
       
            tb.Close
            Set db = Nothing
           
End If
Me.Refresh

End Sub


Boa tarde, nioxys

Será If DLookup("Nome", "AnexosAvarias", "Nome='" & name & "'") <> Null Then

Olá Alexandre,

Fiz as alterações mas não funciona na mesma.

tente
If DCount("*", "AnexosAvarias", "Nome='" & name & "'") >0 Then

Olá,

Só na próxima Segunda-Feira é que posso testar, depois digo o resultado.
Obrigado.

Olá,

Já testei e está a funcionar. Muito obrigado.

Boa noite, nioxys

Dúvida nova deve ser colocada num novo tema