Salvar arquivos automaticamente em pastas destintas

Question

Pessoal, tudo bem?

To tentando usar um código para salvar 3 arquivos destintos que recebo por email em tres pastas destintas, porém não consigo fazer funcionar:

Sub SalvarAnexo()
 Dim Anexo As Attachment
 Dim strExt As String
 Dim strFolder As String
 Dim strFolderData As String
 Dim strFile As String
 Dim MailID As String
 Dim Mail As Outlook.MailItem
 MailID = Email.EntryID
 Set Mail = Application.Session.GetItemFromID(MailID)
For Each Anexo In Mail.Attachments
strExt = Left(Anexo.FileName, 3)
  Select Case strExt
    Case "VDR"
      strFolder = "C:\Users\subf000523\Desktop"
    Case "DV1"
      strFolder = "C:\Users\subf000523\Desktop\Novo Depara"
    Case "DV2"
      strFolder = "C:\Users\subf000523\Desktop\Venda Cia"
  End Select
strDataHoje = Format(Mail.CreationTime, "yyyymmdd")
strFolder = strFolder & Mail.SenderEmailAddress
strFolderData = strFolder & "\" & strDataHoje & "\"
    On Error Resume Next
    MkDir strFolder
    MkDir strFolderData
        On Error GoTo 0
        strFile = strFolderData & Format(Mail.CreationTime, "yyyymmdd-hhnnss-") & Anexo.FileName
        Anexo.SaveAsFile strFile
    Mail.UnRead = False
    Next Anexo
End Sub

Conseguem ajudar?

Abs

Answer 1

Boa tarde Matheusamp,

Ocorre algum erro? Consegue nos fornecer maiores detalhes do que exatamente não está funcionando? Este código não é fácil de replicar, pois teríamos que ter o cenário exato para tentar simular. Então se fornecer a maior quantidade de informações possíveis facilita pra gente, ok?

Um abraço!