... Assinatura do site por 1 ano + Kit MontaRibbons + 3 Livros em PDF + Diversas Revistas (pdf) de brinde, por apenas R$100,00
(
podendo parcelar em até 10 vezes no cartão de crédito)...

Clique aqui e obtenha mais detalhes do nosso kit completo e de como comprar.


Fazer Upload de Arquivo para Pasta

Usuário Arboit :

Olá, amigo!

Tenho uma rotina que importa arquivos PDF para uma pasta específica. Até aí tudo bem, pois está funcionando corretamente. O que desejo é que antes de fazer a importação, o sistema me informe se já existe o arquivo armazenado lá ou não, e se quero sobrescrevê-lo ou não.

O código VBA que estou usando é esse:

Private Sub btnSelecionar_Click()
Const strDestination = "C:\SistemaAccess\tags\" 'Local onde ficam armazenados os arquivos
Dim varFilename As Variant
Dim lngPos As Long
  
With Application.FileDialog(1) ' 1 = msoFileDialogOpen
  .AllowMultiSelect = True
  .Filters.Clear
  .Filters.Add "Arquivos PDF", "*.pdf"
  If .Show Then
     For Each varFilename In .SelectedItems
        lngPos = InStrRev(varFilename, "\")
        DoCmd.Hourglass True
        FileCopy varFilename, strDestination & Mid(varFilename, lngPos + 1)
        MsgBox "Importado com Sucesso...", vbInformation, "Upload"
      Next varFilename
  End If
End With
DoCmd.Hourglass False
Call fncListaTags 'Função que lista os arquivos em uma caixa de listagem
End Sub

Tentei adaptar algumas rotinas, mas nenhuma deu certo. Se puder me ajudar, agradeço.

Suporte:

Arboit, experimente usar a função Dir() do Access para detectar o arquivo na pasta.  Atente para parte em vermelho, no código.

Private Sub btnSelecionar_Click()
Const strDestination = "C:\SistemaAccess\tags\" 'Local onde ficam armazenados os arquivos
Dim varFilename As Variant
Dim lngPos As Long
  
With Application.FileDialog(1) ' 1 = msoFileDialogOpen
  .AllowMultiSelect = True
  .Filters.Clear
  .Filters.Add "Arquivos PDF", "*.pdf"
  If .Show Then
     For Each varFilename In .SelectedItems
        lngPos = InStrRev(varFilename, "\")
        DoCmd.Hourglass True
        'Verifica se o arquivo já se encontra na pasta
        if len(dir(strDestination & Mid(varFilename, lngPos + 1))) > 0 then
           'Abre a mensagem, dando a opção se deseja substituí-lo
           if msgbox("Arquivo já existe.  Deseja substituir ?, _ 
              vbYesNo + vbQuestion ,"Confirmação") = vbYes then
              FileCopy varFilename, strDestination & Mid(varFilename, lngPos + 1)
              MsgBox "Importado com Sucesso...", vbInformation, "Upload"
           end if
        else
           FileCopy varFilename, strDestination & Mid(varFilename, lngPos + 1)
           MsgBox "Importado com Sucesso", vbInformation, "Upload"
        end if
      Next varFilename 
  End If
End With
DoCmd.Hourglass False
Call fncListaTags 'Função que lista os arquivos em uma caixa de listagem
End Sub

Usuário Arboit :

Como sempre, problema resolvido! Muito obrigado novamente.

 


 

 


Não há comentário

Envie seu comentário: