[Resolvido]Capturar ficheiros, numa nova situação.

Olá Feras de plantão, boa noite.

Há tempos utilizo um código do Mestre JPaulo para capturar ficheiros que possuam uma imagem jpg e escrever o caminho completo desta imagem numa tabela e funciona redondinho.
O problema atual é que esta tabela agora é vinculada a outra num relacionamento 1/Muitos e não consigo mais fazer a "coisa funfar legal.
Explicando: Possuo um formulário vinculado à tabela tblColeção que possui um campo de chave primária Index e outros campos. A tabela tblColeção se relaciona com a tabela tblPastas (do lado Muitos) pelo campo Index do tipo numero. Nesta tabela existe o campo Pastas que armazena o caminho do ficheiro.
Quando desfaço o relacionamento a coisa funciona mas quando crio o relacionamento não consigo capturar ficheiro algum.

O código é esse:

Option Compare Database
Option Explicit
   Public Function ContaFicheirosExtraiNome(strCaminho As String, strIncluiSubPastas As Boolean)
   'By JPaulo ® Maximo Access
   'Requer a seguinte referência VBA ativa:
   'Microsoft Scripting Runtime
   'Para chamar a função, deve colocar no pressionar de um botão: Call ContaFicheirosExtraiNome("C:\SuaPasta\",True)
   Dim fso As Object, strPasta As Object, strSubPasta As Object, strFicheiro As Object
   Dim strConta As Long, strSql As String
     
       Set fso = CreateObject("Scripting.FileSystemObject")
       
       Set strPasta = fso.GetFolder(strCaminho)
       'Percorre a drive e extraí o nome das pastas, subPastas e ficheiros
       For Each strFicheiro In strPasta.Files
     
       'Insere na tabela o caminho completo dos ficheiros com as extensões JPEG
               If Mid([strFicheiro], InStrRev([strFicheiro], "\") + 1) Like "*.jpg*" Then
                   CurrentDb.Execute "INSERT INTO tblPastas (Pastas) SELECT '" & strPasta.path & "\" & strFicheiro.NAME & "'"
                   'CurrentDb.Execute "INSERT INTO tblPastas (Pastas) SELECT '" & Replace(strPasta.path, "'", "''") & "\" & strFicheiro.NAME & "'"
           strConta = strConta + 1
           
           Else
           End If
       Next strFicheiro
       'Se existirem subpastas, insere na tabela o caminho completo dos ficheiros
       If strIncluiSubPastas = True Then
           For Each strSubPasta In strPasta.SubFolders
               ContaFicheirosExtraiNome strSubPasta.path, True
           Next strSubPasta
       End If
       Set strFicheiro = Nothing
       Set strPasta = Nothing
   End Function

No formulário possuo um botão de comando com o seguinte código:

Private Sub Comando1_Click()
Dim strCaminho As String
If MsgBox("Você está seguro de executar esta ação no momento ? " & Chr(13) & "Saiba que irá alterar toda a base de dados. ", vbYesNo, " InfoBasic Smart System") = 6 Then
MsgBox "Essa operação pode demorar alguns minutos, por favor, Aguarde ... ", , " InfoBasic Smart System"
strCaminho = InputBox("Introduza o caminho dos ficheiros.")
Me.Caption = "      Por favor, aguarde ..."
Screen.MousePointer = 11
Me.TimerInterval = 2000
Call ContaFicheirosExtraiNome(strCaminho, True)
MsgBox "Arquivos importados com sucesso.   ", , "  InfoBasic Smart System"
Screen.MousePointer = 0
Me.TimerInterval = 0
Call MouseCursor(32649&)
Me.Refresh
Me.Caption = "    InfoBasic Smart System"
Else
MsgBox "A ação de capitura foi cancelada pelo usuário. ", vbInformation, " InfoBasic Smart System"
End If
End Sub


Já torrei milhões de neurônios e não consigo fazer a coisa funcionar quando ambas as tabelas estão vinculadas.
Sem o relacionamento volto a afirmar que funciona mas o campo Index da tabela tblPastas fica em branco.

A imagem abaixo mostra o resultado quando desfaço o relacionamento:


" />



Alguém se habilita?

Abraços, WSenna

Uma idéia que me veio à cabeça seria manter as tabelas sem vínculo e de alguma forma inserir o valor do campo Index da tabela tblColeção no campo Index da tabela tblPastas, mas como?

O final desejado é este:

Após a captura dos ficheiros poder exibir as imagens como segue abaixo:

[img][/img]


Abraços, WSenna

Grande Avelino, bom dia.

Amigão, não tenho palavras para agradecer tamanha ajuda.
Seguindo seu conselho fiz algumas modificações e a "coisa" funfou plenamente, agora com as tabelas tblColeção e tblPastas vinculadas.

Heis o novo código:

   Public Function ContaFicheirosExtraiNome(strCaminho As String, strIncluiSubPastas As Boolean)
   'By JPaulo ® Maximo Access
   'Modificado por Avelino Sampaio e Wagner Senna
   'Requer a seguinte referência VBA ativa:
   'Microsoft Scripting Runtime
   'Para chamar a função, deve colocar no pressionar de um botão: Call ContaFicheirosExtraiNome("C:\SuaPasta\",True)
   Dim fso As Object, strPasta As Object, strSubPasta As Object, strFicheiro As Object
   Dim strConta As Long, strSql As String
   Dim strIndex As Long
   strIndex = Forms![frmPastas]![Index]
     
       Set fso = CreateObject("Scripting.FileSystemObject")
       
       Set strPasta = fso.GetFolder(strCaminho)
       'Percorre a drive e extraí o nome das pastas, subPastas e ficheiros
       For Each strFicheiro In strPasta.Files
     
       'Insere na tabela o caminho completo dos ficheiros com as extensões JPEG e o Index correspondente ao registro da tabela tblColeção
               If Mid([strFicheiro], InStrRev([strFicheiro], "\") + 1) Like "*.jpg*" Then
                   CurrentDb.Execute "INSERT INTO tblPastas (Index, Pastas) SELECT " & strIndex & ",'" & strPasta.path & "\" & strFicheiro.NAME & "'"
           strConta = strConta + 1
           
           Else
           End If
       Next strFicheiro
       'Se existirem subpastas, insere na tabela o caminho completo dos ficheiros
       If strIncluiSubPastas = True Then
           For Each strSubPasta In strPasta.SubFolders
               ContaFicheirosExtraiNome strSubPasta.path, True
           Next strSubPasta
       End If
       Set strFicheiro = Nothing
       Set strPasta = Nothing
   End Function


Abraços, WSenna

Boa tarde, li esse post, achei bem interessante esse exemplo do sr. WSenna, não poderia disponibilizar o exemplo, para estudo, acredito que no meu trabalho poderei utilizar para guardar as fotos das vistoria de edificação que temos que fazer.

Obrigada

Oi Amanda, boa tarde.

Amiga, este exemplo acima faz parte de um imenso banco de dados e ainda não pensei em desmembra-lo para o que necessitas, entretanto eu disponibilizei um outro modelo, o Photo Gallery, que acredito possa lhe servir.
caso não seja o que você necessita, com um pouquinho de esforço e baseando-se nas laudas acima você poderá facilmente construir ou reconstruir este que lhe falei.

Veja o link: http://maximoaccess.forumeiros.com/t22366-photo-gallery

Abraços, WSenna

Obrigada, meu amigo vou seguir com seus conselhos, desculpe qualquer coisa,

Grande abraço, uma ótima semana

Amandaalves