Fazer Upload de Arquivo para Pasta
Nota importante: para ter acesso aos vídeos e arquivos exemplos deste site, adquira um dos planos apresentados abaixo. Você pode comprar em até 5x no Cartão de Crédito.
Veja como comprar e saiba mais sobre o material oferecido, clicando aqui.
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 |
