Mover arquivos entre pastas, via VBA
Nota importante: para ter acesso aos vídeos e arquivos exemplos deste site, adquira um dos planos apresentados abaixo. Você pode comprar em até 2x no Cartão de Crédito.
Veja como comprar e saiba mais sobre o material oferecido, clicando aqui.
Usuário Fábio:
Bom dia.
Gostaria, de após enviar o e-mail com os meus anexos, que o meu código ainda movesse dois arquivos para uma subpasta, que deve ser criada com o nome do mês atual. Ex: novembro 2017
Estou utilizando o código abaixo, para mover o arquivo para a pasta enviados, mas não consigo que envie para a subpasta. É aí que preciso de ajuda.
file = "NF " & frmq!CboCentrodeCusto.Column(0) & " " & Format(DateAdd("m", -1, Date), "mmmm yyyy") & ".pdf"
sfol = CurrentProject.Path & "\trabalhando\" 'caminho inicial
dfol = CurrentProject.Path & "\enviados\" 'caminho destino
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(sfol & file) Then
MsgBox sfol & file & " não existet!", vbExclamation, "Erro"
ElseIf Not fso.FileExists(dfol & file) Then
fso.MoveFile (sfol & file), dfol
Else
MsgBox dfol & file & " existente!", vbExclamation, "Sucesso"
End If
No aguardo.
Suporte:
Fábio, testei aqui e funcionou bem desta forma abaixo. Atente para as partes em vermelho.
file = "NF " & frmq!CboCentrodeCusto.Column(0) & " " & Format(DateAdd("m", -1, Date), "mmmm yyyy") & ".pdf"
sfol = CurrentProject.Path & "\trabalhando\" 'caminho inicial
dfol = CurrentProject.Path & "\enviados\" & Format(date, "mmmm yyyy") & "\" 'destino
If Not Dir(dfol, vbDirectory) <> "" Then MkDir (dfol)
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(sfol & File) Then
MsgBox sfol & File & " não existet!", vbExclamation, "Erro"
ElseIf Not fso.FileExists(dfol & File) Then
fso.MoveFile (sfol & File), dfol
Else
MsgBox dfol & File & " existente!", vbExclamation, "Sucesso"
End If
Usuário Fábio:
Funcionou perfeitamente Avelino.
Muito obrigado mais uma vez pelo seu tempo e atenção.
| Não há comentário |
