Remove From My Forums

Preciso adaptar um código já existente para Encaminhar emails automaticamente

Pergunta

Entrar para Votar

Eu preciso adaptar o código que já é utilizado, para encaminhar o e-mail com os anexos para duas pessoas caso haja em anexo um arquivo .pdf

segue o código

Public Sub ProcessarAnexo(Email As MailItem)
    Dim DiretorioAnexos As String
    DiretorioAnexos = "O:\GestaoXML\XMLRECEBIDO\"

    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
        'If Right(Anexo.FileName, 3) = "pdf" Then
            'ENVIAR PARA "A@A.COM" & "B@B.COM"
        'End If
        
        End If
    Next
    
    Set Mail = Nothing
End Sub

terça-feira, 5 de junho de 2018 18:57

Respostas

Entrar para Votar

Acho que agora vai.

Public Sub ProcessarAnexo(email As MailItem)
    Dim DiretorioAnexos As String
    DiretorioAnexos = "O:\GestaoXML\XMLRECEBIDO\"

    Dim MailID As String
    Dim Mail As Outlook.MailItem
    
    MailID = email.EntryID
    Set Mail = Application.Session.GetItemFromID(MailID)
 
    flagXML = False
    flagPDF = False
    
    For Each Anexo In Mail.Attachments
        If Right(Anexo.FileName, 3) = "xml" Then
            flagXML = True
            Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
        ElseIf Right(Anexo.FileName, 3) = "pdf" Then
            flagPDF = True
        End If
    Next
    
    'in case that there are multiple pdf attachemnts in the mail
    'use a flag to mark to forward the mails istead of forwarding the mail directly
    Dim ForWardMail As Outlook.MailItem
    If (flagXML And flagPDF) Then
        Set ForWardMail = Mail.Forward
        With ForWardMail
        .Recipients.Add "gabriel@gabriel"
        .Recipients.Add "francisco@francisco"
        .Display
        'send with send the mail directly
        '
        '.Send
        End With
    End If
    
    Set Mail = Nothing
End Sub

https://inframicrosoft.wordpress.com/

Marcado como Resposta Gabriel Alves Ferreira segunda-feira, 11 de junho de 2018 12:38

quinta-feira, 7 de junho de 2018 13:17

Todas as Respostas

0

Entrar para Votar

Olá.

E em qual parte do script está enfrentando dificuldade?
https://inframicrosoft.wordpress.com/

terça-feira, 5 de junho de 2018 19:02

Responder

|

Citação
0

Entrar para Votar

Não sei que código inserir pra ele encaminhar os e-mails com os anexos quando o e-mail que chegar e tiver em anexo um .pdf

Tenho muito pouca experiência com Vba

terça-feira, 5 de junho de 2018 19:05

Responder

|

Citação
0

Entrar para Votar

Como e quando o script deverá ser acionado?
https://inframicrosoft.wordpress.com/

terça-feira, 5 de junho de 2018 19:42

Responder

|

Citação
0

Entrar para Votar

No script atual, ele verifica o e-mail que chega na caixa de entrada e salva tiver um anexo de formato .XML.

Gostaria de além de verificar e baixar caso houver um arquivo .xml, se também houver um arquivo .pdf encaminhar esse e-mail com os anexos para duas pessoas.

terça-feira, 5 de junho de 2018 19:51

Responder

|

Citação
0

Entrar para Votar

Isso funciona como uma regra do próprio Outlook?
https://inframicrosoft.wordpress.com/

terça-feira, 5 de junho de 2018 19:52

Responder

|

Citação
0

Entrar para Votar

sim, a regra chama o script

terça-feira, 5 de junho de 2018 19:52

Responder

|

Citação
0

Entrar para Votar

Ok.

Veja:

Link 1

Link 2

Tente elaborar seu script com base nisso e se tiver alguma dúvida é só replicar.
https://inframicrosoft.wordpress.com/

terça-feira, 5 de junho de 2018 19:58

Responder

|

Citação

Entrar para Votar

recebi esse script aqui, mas também não funcionou.

Public Sub ProcessarAnexo(email As MailItem)
    Dim DiretorioAnexos As String
    DiretorioAnexos = "O:\GestaoXML\XMLRECEBIDO\"

    Dim MailID As String
    Dim Mail As Outlook.MailItem
    
    MailID = email.EntryID
    Set Mail = Application.Session.GetItemFromID(MailID)
    forwardFlag = False
    For Each Anexo In Mail.Attachments
        If Right(Anexo.FileName, 3) = "xml" & Right(Anexo.FileName, 3) = "pdf" Then
            Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName & forwardFlag = True
            
        ElseIf Right(Anexo.FileName, 3) = "xml" Then
            Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
        End If
    Next
    'in case that there are multiple pdf attachemnts in the mail
    'use a flag to mark to forward the mails istead of forwarding the mail directly
    Dim ForWardMail As Outlook.MailItem
    If forwardFlag Then
        Set ForWardMail = Mail.Forward
        With ForWardMail
        .Recipients.Add "gabriel@gabriel"
        .Recipients.Add "francisco@francisco"
        .Display
        'send with send the mail directly
        'send
        End With
    End If
    
    Set Mail = Nothing
End Sub

Editado Gabriel Alves Ferreira quarta-feira, 6 de junho de 2018 17:50

quarta-feira, 6 de junho de 2018 16:32

0

Entrar para Votar

Recapitulando:

Se houver um ou mais xml como anexo, salvar na pasta.

Se houver um ou mais pdf, independente de outros anexos, enviar a mensagem.

Está correto o raciocínio acima?

https://inframicrosoft.wordpress.com/

quarta-feira, 6 de junho de 2018 17:28

Responder

|

Citação
0

Entrar para Votar
For Each Anexo In Mail.Attachments If Right(Anexo.FileName, 3) = "xml" & Right(Anexo.FileName, 3) = "pdf" Then Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName & forwardFlag = True ElseIf Right(Anexo.FileName, 3) = "xml" Then Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName End If

Se houver um ou mais xml e pdf, salvar xml e encaminhar e-mail

Se houver um ou mais xml, apenas salvar

A intenção desse script é salvar o xml em um diretório base de um software de gestão. Porém, se houver .pdf, isso quer dizer que esse pdf é uma nota fiscal que deve ser direcionada para o e-mail do financeiro.
quarta-feira, 6 de junho de 2018 17:40

Responder

|

Citação

Entrar para Votar

Olá.

Pensei assim:

  forwardFlag = False
    flagXML = False
    
    For Each Anexo In Mail.Attachments
        If Right(Anexo.FileName, 3) = "xml" Then
            Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
            flagXML = True
        ElseIf Right(Anexo.FileName, 3) = "pdf" Then
            forwardFlag = flagXML
        End If
    Next

Acrescentei uma flag para saber se tem xml.

https://inframicrosoft.wordpress.com/

quarta-feira, 6 de junho de 2018 18:53

Entrar para Votar

Ainda não funciona, acredito que estou com algum problema no office. Inseri 7 MSGBOX pelo código, e ao receber um e-mail só com pdf, ou só com xml ou com os dois arquivos, só me retornou o numero 1, 4 e 7

Segue o codigo:

Office 2010

Public Sub ProcessarAnexo(email As MailItem)
    Dim DiretorioAnexos As String
    DiretorioAnexos = "O:\GestaoXML\XMLRECEBIDO\"

    Dim MailID As String
    Dim Mail As Outlook.MailItem
    
    MailID = email.EntryID
    Set Mail = Application.Session.GetItemFromID(MailID)
    forwardFlag = False
    MsgBox "1"
    For Each anexo In Mail.Attachments
        If Right(anexo.FileName, 3) = "xml" Then
            anexo.SaveAsFile DiretorioAnexos & anexo.FileName
            MsgBox "2"
        ElseIf Right(anexo.FileName, 3) = "pdf" Then
            forwardFlag = True
            MsgBox "3"
        End If
    Next
    'in case that there are multiple pdf attachemnts in the mail
    'use a flag to mark to forward the mails istead of forwarding the mail directly
    Dim ForWardMail As Outlook.MailItem
    MsgBox "4"
    If forwardFlag Then
        Set ForWardMail = Mail.Forward
        MsgBox "5"
        With ForWardMail
        .Recipients.Add "a@a.com"
        .Recipients.Add "B@B.com"
        .Display
        'send with send the mail directly
        .Send
        MsgBox "6"
        End With
        
    End If
    
    Set Mail = Nothing
    MsgBox "7"
End Sub

Editado Gabriel Alves Ferreira quarta-feira, 6 de junho de 2018 19:51

quarta-feira, 6 de junho de 2018 19:50

Entrar para Votar

Acho que agora vai.

Public Sub ProcessarAnexo(email As MailItem)
    Dim DiretorioAnexos As String
    DiretorioAnexos = "O:\GestaoXML\XMLRECEBIDO\"

    Dim MailID As String
    Dim Mail As Outlook.MailItem
    
    MailID = email.EntryID
    Set Mail = Application.Session.GetItemFromID(MailID)
 
    flagXML = False
    flagPDF = False
    
    For Each Anexo In Mail.Attachments
        If Right(Anexo.FileName, 3) = "xml" Then
            flagXML = True
            Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
        ElseIf Right(Anexo.FileName, 3) = "pdf" Then
            flagPDF = True
        End If
    Next
    
    'in case that there are multiple pdf attachemnts in the mail
    'use a flag to mark to forward the mails istead of forwarding the mail directly
    Dim ForWardMail As Outlook.MailItem
    If (flagXML And flagPDF) Then
        Set ForWardMail = Mail.Forward
        With ForWardMail
        .Recipients.Add "gabriel@gabriel"
        .Recipients.Add "francisco@francisco"
        .Display
        'send with send the mail directly
        '
        '.Send
        End With
    End If
    
    Set Mail = Nothing
End Sub

https://inframicrosoft.wordpress.com/

Marcado como Resposta Gabriel Alves Ferreira segunda-feira, 11 de junho de 2018 12:38

quinta-feira, 7 de junho de 2018 13:17

0

Entrar para Votar

Amigos, eu to quase desistindo.

Em todos os códigos que vão me passando e não funcionam eu coloco msgbox pra ver se ele chega a entrar no for ou no if, porém, nenhuma msg box que é inserida dentro do for ou if aparece, toda msgbox que esta fora do for e do if aparece normalmente quando chega um e-mail.

Pode ser um problema de configuração?

quinta-feira, 7 de junho de 2018 14:04

Responder

|

Citação
0

Entrar para Votar

Aqui nos meus testes funcionou.
https://inframicrosoft.wordpress.com/

quinta-feira, 7 de junho de 2018 14:45

Responder

|

Citação
0

Entrar para Votar

Encontrei o erro.

O e-mail onde era testado estava configurado como IMAP e só funciona com POP.

ultima dúvida, eu gostaria que após enviar o e-mail ele muda-se a pasta. Da caixa de entrada para uma pasta chamada "Arquivado"

quinta-feira, 7 de junho de 2018 18:02

Responder

|

Citação
0

Entrar para Votar
Veja o link 1 enviado anteriormente, lá tem um exemplo de como mover para outra pasta.

https://inframicrosoft.wordpress.com/
- Editado J. Maurício quinta-feira, 7 de junho de 2018 18:09
quinta-feira, 7 de junho de 2018 18:08

Responder

|

Citação

Entrar para Votar

Inseri esse código porém não funcionou.

'...    'end if
Dim SubFolder As Outlook.MAPIFolder
    Dim ns As Outlook.NameSpace
    Set ns = Application.GetNamespace("MAPI")
    
    Set SubFolder = ns.Folders("Arquivado")
    
    Mail.Move SubFolder
    
    Set SubFolder = Nothing
    
    Set Mail = Nothing
End Sub

sexta-feira, 8 de junho de 2018 12:37

0

Entrar para Votar
Olá.

Desculpe-me. A sugestão sobre o link não ajudava. Foi um equívoco.

Apenas tente colocar a linha abaixo depois de ter encaminhado o e-mail (e dentro do if):

Mail.Move (Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Arquivado"))

No meu teste funcionou.

https://inframicrosoft.wordpress.com/
- Editado J. Maurício sexta-feira, 8 de junho de 2018 14:16
sexta-feira, 8 de junho de 2018 14:15

Responder

|

Citação

Entrar para Votar

Opa Mauricio, confirma se ta tudo ok.

Rodei aqui, porém não arquivou.

Public Sub ProcessarAnexo(email As MailItem)
    Dim DiretorioAnexos As String
    DiretorioAnexos = "C:\Users\gabriel\Documents\xmlepdf\"

    Dim MailID As String
    Dim Mail As Outlook.MailItem
     
    MailID = email.EntryID
    Set Mail = Application.Session.GetItemFromID(MailID)
 
    flagXML = False
    flagPDF = False
   
    For Each anexo In Mail.Attachments
    
        If Right(anexo.FileName, 3) = "xml" Or Right(anexo.FileName, 3) = "XML" Then
            flagXML = True
            anexo.SaveAsFile DiretorioAnexos & anexo.FileName
        End If
        
        If Right(anexo.FileName, 3) = "pdf" Or Right(anexo.FileName, 3) = "PDF" Then
            flagPDF = True
        End If
        
    Next
    
    'in case that there are multiple pdf attachemnts in the mail
    'use a flag to mark to forward the mails istead of forwarding the mail directly
    Dim ForWardMail As Outlook.MailItem
    If (flagXML And flagPDF) Then
        Set ForWardMail = Mail.Forward
        With ForWardMail
        .Recipients.Add "a@a"
        .Recipients.Add "b@b"
        .Display
        'send with send the mail directly
        '
        .Send
        End With
    Mail.Move (Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Arquivado"))
    
    End If

    
    Set Mail = Nothing
End Sub

sexta-feira, 8 de junho de 2018 14:27

Entrar para Votar

Olha o meu código:

Public Sub ProcessarAnexo(email As MailItem)
    Dim DiretorioAnexos As String
    DiretorioAnexos = "O:\GestaoXML\XMLRECEBIDO\"

    Dim MailID As String
    Dim Mail As Outlook.MailItem
    
    MailID = email.EntryID
    Set Mail = Application.Session.GetItemFromID(MailID)
 
    flagXML = False
    flagPDF = False
    
    For Each Anexo In Mail.Attachments
        If Right(Anexo.FileName, 3) = "xml" Then
            flagXML = True
            Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
        ElseIf Right(Anexo.FileName, 3) = "pdf" Then
            flagPDF = True
        End If
    Next
    
    'in case that there are multiple pdf attachemnts in the mail
    'use a flag to mark to forward the mails istead of forwarding the mail directly
    Dim ForWardMail As Outlook.MailItem
    If (flagXML And flagPDF) Then
        Set ForWardMail = Mail.Forward
        With ForWardMail
            .Recipients.Add "gabriel@gabriel"
            .Recipients.Add "francisco@francisco"
            .Display
            'send with send the mail directly
            '
            '.Send
        End With
        Mail.Move (Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Pasta"))
    End If
    
    Set Mail = Nothing
End Sub

Não achei diferença. Sua pasta arquivado está dentro da imbox?

https://inframicrosoft.wordpress.com/

sexta-feira, 8 de junho de 2018 14:41

0

Entrar para Votar

sexta-feira, 8 de junho de 2018 14:47

Responder

|

Citação
0

Entrar para Votar
Faz um teste. Tenta criar uma pasta dentro de Caixa de Entrada e tenta mover para essa nova pasta.

https://inframicrosoft.wordpress.com/
- Editado J. Maurício sexta-feira, 8 de junho de 2018 14:56
sexta-feira, 8 de junho de 2018 14:55

Responder

|

Citação
0

Entrar para Votar

Nada ainda

sexta-feira, 8 de junho de 2018 15:02

Responder

|

Citação
0

Entrar para Votar
Eu utilizo Exchange aqui. Não sei se pode ser algo de configuração. Não sei o que pode estar ocorrendo. Você tentou mover sem enviar?

https://inframicrosoft.wordpress.com/
- Editado J. Maurício sexta-feira, 8 de junho de 2018 15:15
sexta-feira, 8 de junho de 2018 15:13

Responder

|

Citação
0

Entrar para Votar

Não tem nada haver por ter um comando "getdefaultfolder"?

acredito que essa pasta não seja padrão!

sexta-feira, 8 de junho de 2018 16:28

Responder

|

Citação

Produtos

Resources

Solutions

Atualizações

Avaliações

Sites relacionados

Treinamento

Certificações

Outros recursos

Por produtos

Outros links

Não é um IT Pro?

Usuário com melhor resposta

Preciso adaptar um código já existente para Encaminhar emails automaticamente

Pergunta

Respostas

Todas as Respostas