none
Macro para receber automaticamente arquivos XML e PDF dos anexos no outlook 2010 RRS feed

  • Pergunta

  • Ola pessoal, já pesquisei no fórum e encontrei o script abaixo, só que como não entendo nada de VBA gostaria de uma ajuda dos nobres para resolver algumas duvidas.

    - Recebo email de vários fornecedores com XML e PDF

    - Cada um tem uma pasta para gravar o XML e PDF

    Gostaria que o script verifica-se o email que estou recebendo, identifica-se quem enviou, e salva-se na pasta referente ao destinatário, salvando o xml e o pdf em suas respectivas pastas. Como são vários fornecedores eu teria que definir cada email com a pasta de destino...

    Se alguém puder ajudar...

    Segue o script que encontrei no fórum

    Public Sub ProcessarAnexo(Email As MailItem)
         Dim DiretorioAnexos As String
         
         DiretorioAnexos = "d:\NFE"
         
         Dim MailID As String
         Dim Mail As Outlook.MailItem
         
         MailID = Email.EntryID
         Set Mail = Application.Session.GetItemFromID(MailID)
             
         For Each Anexo In Mail.Attachments
             If Right(Anexo.FileName, 3) = "xml" Then
                 Anexo.SaveAsFile DiretorioAnexos & "\" & Anexo.FileName
                 
             End If
         Next
         
         Set Mail = Nothing
     End Sub

    Usei esse script com a regra abaixo

    Aplicar essa regra depois que o email chegar de XXX@XXX.com.br e somente neste computador mover para a pasta XXX e executar Script

    Marcio

    quarta-feira, 15 de janeiro de 2014 13:42

Respostas

  • Vailati,

    Eu não tenho como testar mas veja se isto ajuda:

    Public Sub ProcessarAnexo(Email As MailItem)
    	Dim DiretorioAnexos As String
    
    	Dim MailID As String
    	Dim Mail As Outlook.MailItem
    
    	MailID = Email.EntryID
    	Set Mail = Application.Session.GetItemFromID(MailID)
    
    	'Define o diretório para salvar dependendo de
    	'quem enviou o e-mail
    	If Mail.SenderEmailAddress = "someone@example.com" Then
    		DiretorioAnexos = "d:\NFE\Example"
    	elseif Mail.SenderEmailAddress = "someone@teste.com" Then
    		DiretorioAnexos = "d:\NFE\Teste"
    	else
    		DiretorioAnexos = "d:\NFE\outros"
    	end if
    	
    	
    	For Each Anexo In Mail.Attachments
    	        If Right(Anexo.FileName, 3) = "xml" Then
    		        Anexo.SaveAsFile DiretorioAnexos & "\" & Anexo.FileName
    
    	        End If
    	Next
    
    	Set Mail = Nothing
     End Sub

    Ref.:

    MailItem.SenderEmailAddress Property (Outlook)

    http://msdn.microsoft.com/en-us/library/office/ff868262.aspx


    Fábio de Paula Junior

    quarta-feira, 15 de janeiro de 2014 19:54
    Moderador