[Resolvido]Criar sistemática para duplicar um arquivo de uma pasta para outra com nomes específicos de uma lista

bom dia,

Alguém conseguiria um código para eu copiar um arquivo PDF e replicá-lo com nomes que eu determinar provenientes de uma tabela?
Ou seja, eu tenho um único arquivo PDF salvo em uma pasta e uma tabela no access com um campo apenas e com os seguintes dados: PV123; PV124; PV125... , preciso que o sistema pegue esse arquivo pdf e o transforme em vários outros com os nomes dos dados da tabela: PV123.pdf; PV124.pdf; PV125.pdf...

Olá Ricardo,
Com o FileCopy função nativa do Access consegue fazer o pretendido.
Já experimentou uma busca aqui no fórum, Veja como fazer:
https://www.maximoaccess.com/t1115-busca-no-forum-search

Abraço

Obrigado pelo pronto atendimento.

Achei esse código que faz uma cópia do que existe na pasta e o replica em outra pasta:

Public Sub CopiaPasta()
'By JPaulo ® Maximo Access
'Necessario ativar a referencia VBA
'Microsoft Scriting Runtime
Dim fso
Dim strOrigem As String, strDestino As String
strOrigem = "C:\PastaOrigem" ' caminho de origem da pasta"
strDestino = "C:\PastaDestino" ' caminho de destino"
Set fso = CreateObject("Scripting.FileSystemObject")

fso.CopyFolder strOrigem, strDestino
MsgBox "Pasta e ficheiros copiados com sucesso !"
End Sub

Porém, preciso que ele o replique utilizando um campo de uma tabela com os respectivos nomes que nela existirem.
Ou seja, o código acima copia o arquivo teste.pdf para uma outra pasta. Eu preciso que ele copie e vá renomeando de acordo com o campo da tabela.
Então se a tabela possui os dados PV123, PV124, PV125... Ele teria de copiar o arquivo e ir replicando de acordo com esses nomes, ficando assim: PV123.PDF, PV124.PDF, PV125.PDF...

Olá Ricardo,

1) A copia é para fazer tudo de uma só vez (alterando a extensão, parece que é isso) ou;
2) em determinada altura quando está com o formulario a trabalhar num registo especifico (exemplo PV125), ou ainda;
3) Correr a tabela e proceder a copia dos registos da tabela?

Veja se consegue explicar melhor, ou até postar base de dados com objetos envolvidos e dados de amostragem.

Abraço

Vou tentar detalhar melhor.

1 - Eu possuo um arquivo PDF somente. Exemplo teste.pdf
2 - Tenho uma tabela com um campo somente com vários registros: Exemplo: campo1 (com os seguintes registros listados: PV123, PV124, PV125...)

Eu pretendia pegar os registros do campo1 e ir copiando o arquivo PDF e colando com os nomes que aparecem no campo1.
Então se meu campo tivesse 1.000 registros o sistema pegaria esse PDF e o replicaria 1.000 vezes com os nomes desses registros.

Olá Ricardo,
Quando se refere aos 1000 registos:

a) numa tabela com 1000 linhas de registo
b) No campo (exemplo Campo1) tem lá os nomes separados por virgula exemplo (PV123, PV124, PV125)

Abraço

Bom dia !

Se não se importam, teste por favor;

Código:

Public Sub CopiaFicheiro()
'By JPaulo ® Maximo Access
'Necessario ativar a referencia VBA
'Microsoft Scriting Runtime
Dim RS As DAO.Recordset
Dim db As DAO.Database
Dim fso
Dim strOrigem As String
Dim strFile As String
Dim strDestino As String

Set db = CurrentDb
'abre o recordset á sua tabela
Set RS = db.OpenRecordset("select * from SuaTabela", dbOpenDynaset)
'caminho da pasta de origem do ficheiro
strOrigem = "C:\teste.PDF"
'nome do ficheiro
strFile = "teste.PDF"
'caminho para a copia
strDestino = "C:\temp\"
'seta o Scripting
Set fso = CreateObject("Scripting.FileSystemObject")

'se não existirem registos na tabela, morre aqui
If RS.RecordCount = 0 Then Exit Sub
'se existirem, coloca-se no primeiro registo
RS.MoveFirst

'percorre todos os registos da tabela
   Do
'renomeia os ficheiros antes da copia
      strDestino = strDestino & Replace(strFile, "teste", RS(0), 1)
'efetua a copia
      fso.CopyFile strOrigem, strDestino
'volta com o destino inicial
      strDestino = "C:\temp\"
      RS.MoveNext
   Loop Until RS.EOF

   RS.Close
   Set RS = Nothing
   Set db = Nothing
End Sub

Olá,

É uma tabela com 1.000 linhas de registro.

Ou mais......

Teste e retorne.

Bom dia,

Rapaz....deu certo viu...

Ele só não avisa quando termina, mas deu certinho. Era isso mesmo.
Muitíssimo obrigado

Já avisa;

Obrigado pelo retorno o forum agradece.

Código:

Public Sub CopiaFicheiro()
'By JPaulo ® Maximo Access
'Necessario ativar a referencia VBA
'Microsoft Scriting Runtime
Dim RS As DAO.Recordset
Dim db As DAO.Database
Dim fso
Dim strOrigem As String
Dim strFile As String
Dim strDestino As String

Set db = CurrentDb
'abre o recordset á sua tabela
Set RS = db.OpenRecordset("select * from SuaTabela", dbOpenDynaset)
'caminho da pasta de origem do ficheiro
strOrigem = "C:\teste.PDF"
'nome do ficheiro
strFile = "teste.PDF"
'caminho para a copia
strDestino = "C:\temp\"
'seta o Scripting
Set fso = CreateObject("Scripting.FileSystemObject")

'se não existirem registos na tabela, morre aqui
If RS.RecordCount = 0 Then Exit Sub
'se existirem, coloca-se no primeiro registo
RS.MoveFirst

'percorre todos os registos da tabela
  Do
'renomeia os ficheiros antes da copia
      strDestino = strDestino & Replace(strFile, "teste", RS(0), 1)
'efetua a copia
      fso.CopyFile strOrigem, strDestino
'volta com o destino inicial
      strDestino = "C:\temp\"
      RS.MoveNext
  Loop Until RS.EOF
MsgBox "Processo terminado com sucesso...", vbInformation
  RS.Close
  Set RS = Nothing
  Set db = Nothing
End Sub

Bom dia,

Perfeito...
Nota 1.000 pra vcs....

jPaulo,

Se eu tivesse varios PDF,s e quisesse nomeá-los na ordem que eles aparecem salvos na pasta, com essa lista de registros do campo1, teria como?
A mesma quantidade de PDF com a mesma quantidade de registros do campo1.

Muda todo o conceito, mas sim funciona;

Teste e retorne:

Código:

Public Sub CopiaFicheiro()
'By JPaulo ® Maximo Access
'Necessario ativar a referencia VBA
'Microsoft Scriting Runtime
Dim RS As DAO.Recordset
Dim db As DAO.Database
Dim fso
Dim strDestino As String
Dim strAllFiles As String
Dim ObjFolder
Dim ObjFile

Set db = CurrentDb
'abre o recordset á sua tabela
Set RS = db.OpenRecordset("select * from SuaTabela", dbOpenDynaset)

'caminho para a copia
strDestino = "C:\temp\"
'seta o Scripting
Set fso = CreateObject("Scripting.FileSystemObject")
'caminho da pasta de origem dos ficheiros
Set ObjFolder = fso.GetFolder("C:\")
'se não existirem registos na tabela, morre aqui
If RS.RecordCount = 0 Then Exit Sub
'se existirem, coloca-se no primeiro registo
RS.MoveFirst

'percorre todos os registos da tabela
  Do
 'percorre todos os ficheiros .pdf na pasta do ObjFolder
 For Each ObjFile In ObjFolder.Files
        If Err.Number <> 0 Then Exit For
       
        If Right(ObjFile, 4) = ".pdf" Then
        strDestino = strDestino & Replace(ObjFile, ObjFile, RS(0), 1) & ".pdf"
              fso.copyfile ObjFile, strDestino
        strDestino = "C:\temp\"
            RS.MoveNext
        End If
'efetua a copia
Next
  Loop Until RS.EOF
MsgBox "Processo terminado com sucesso...", vbInformation
  RS.Close
  Set RS = Nothing
  Set db = Nothing
End Sub

Boa tarde,

Muito bom.
O último código funcionou para as duas situações. Se possuir um arquivo com vários registros ele faz e se possuir vários arquivos para vários registros ele faz também...

Mais uma vez, muito obrigado....

Obrigado pelo retorno o forum agradece.