Notifications
Clear all

Verificar Erros ao enviar E-mail no Outlook

7 Posts
3 Usuários
0 Reactions
1,851 Visualizações
(@leogranja)
Posts: 17
Active Member
Topic starter
 

Prezados, boa tarde! Tudo certo?

Com a ajuda do fórum, estou montando a planilha perfeita (pelo menos para mim) para envio de e-mails com anexo.

Acontece que surgiu uma dúvida e gostaria de ver se conseguem me ajudar.

No código abaixo, tenho uma rotina de FOR que envia e-mail se as células do range T10:T127 atendem os critérios. Se atendem, ele cria um e-mail com um determinado anexo e para determinados endereços de destinatários. Gostaria de criar uma Variável que identificasse que não foi anexado documento ou que Endereco="', dentro da rotina de FOR. Poderia ser uma váriavel que eu colocaria em um msgbox, como por exemplo, msgbox "2 e-mails não possuem destinatário e 1 e-mail não possui anexo".

For Each celly In Sheets("VENDAS CONSOLIDADAS").Range("T10:T127")

  If celly.Offset(0, 2).Value <> "Sim" Then
  
    If celly <> "" Then
        
    Set rng = Nothing
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Set myAttachments = OutMail.Attachments
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    anexo = ThisWorkbook.Path & "" & Sheets("VENDAS CONSOLIDADAS").Range("U2").Value & "" & celly.Offset(0, 1).Value & ".pdf"
    Endereco = Application.WorksheetFunction.VLookup(celly.Offset(0, 3).Value, Sheets("Endereços").Range("A2:B150"), 2, 0)
    Titulo = "Fatura " & celly.Offset(0, 4).Value & " " & Sheets("VENDAS CONSOLIDADAS").Range("X4").Value & "2017/ " & celly.Offset(0, 3).Value
    celly.Offset(0, 2).Value = "Sim"

    On Error Resume Next
    With OutMail
        .display
        StrSig = .HTMLbody
        .To = Endereco
        .CC = Endereco2
        .BCC = ""
        .Subject = Titulo
        .HTMLbody = "<FONT FACE=Calibri (Corpo)>" & StrBody & StrSig
        myAttachments.Add anexo
        .display
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

  End If
    End If

Next celly

End Sub

Muito obrigado!!
Atenciosamente,
Leonardo.

 
Postado : 05/09/2017 10:16 am
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

leogranja,

Boa tarde!

Anexe seu arquivo, por gentileza.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 05/09/2017 11:08 am
(@leogranja)
Posts: 17
Active Member
Topic starter
 

Wagner, boa tarde.

Desculpe a demora, teve o feriado e fiquei enrolado.

Segue planilha. A planilha funciona da seguinte maneira:

O faturamento irá receber a planilha preenchida no range "B10:R13". O faturamento preenche o nº da nota e salva na pasta o .pdf com o nome da nota. Ao clicar no botão envia, a macro abre um e-mail no padrão com a nota anexada e para os endereços indicados.

O que eu gostaria é um contador que verifique se alguma nota não foi anexada ou se o endereço de envio está vazio.

Obrigado pela ajuda.

 
Postado : 11/09/2017 2:24 pm
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

leogranja,

Veja se é assim.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 12/09/2017 7:38 am
(@leogranja)
Posts: 17
Active Member
Topic starter
 

Boa tarde Wagner,

Muito obrigado pelo retorno. Ele está contando os endereços que estão nulos corretamente mas sobre as notas anexadas não é bem isso. Vou tentar explicar:

No código abaixo, a macro anexa o documento que está no endereço da variável "anexo".

anexo = ThisWorkbook.Path & "" & Sheets("VENDAS CONSOLIDADAS").Range("U2").Value & "" & celly.Offset(0, 1).Value & ".pdf"

O que eu gostaria é um contador caso a função "myAttachments.Add anexo" for nula, ou seja, não adicionar nada no e-mail.

                With OutMail
                    .display
                    StrSig = .HTMLbody
                    .To = Endereco
                    .CC = Endereco2
                    .BCC = ""
                    .Subject = Titulo
                    .HTMLbody = "<FONT FACE=Calibri (Corpo)>" & StrBody & StrSig
                    """"""""""""""""""""""""]myAttachments.Add anexo"""""""""""""""""""""
                    .display

Tentei criar o código abaixo mas ele não funciona pois a variável "anexo" sempre terá um valor. O que eu preciso é que a macro identifique que o e-mail criado não possui nenhum anexo.

                anexo = ThisWorkbook.Path & "" & Sheets("VENDAS CONSOLIDADAS").Range("U2").Value & "" & celly.Offset(0, 1).Value & ".pdf"
                If anexo = "" Then
                    ContaNota = ContaNota + 1
                End If

Consegue pensar em uma solução?

EDIT: Segue sugestão do que estou tentando fazer:

        myAttachments.Add anexo
        If MailItem.Attachments = "" Then
                    ContaNota = ContaNota + 1
        End If

Muito obrigado!

 
Postado : 13/09/2017 9:26 am
joebsb
(@joebsb)
Posts: 44
Eminent Member
 

Olá leogranja...

Basta criar uma função para verificar se algum arquivo foi pego..... por exemplo:

Substitua o código que vc colocou abaixo:


If anexo = "" Then
     ContaNota = ContaNota + 1
End If

Por esta linha:

If ExisteArquivo(anexo) = False Then ContaNota = ContaNota + 1

Depois insira o código abaixo no final de todo seu código


Public Function ExisteArquivo(caminhodoarquivo As String) As Boolean
'Macro criada por Joe em 13/09/2017
'Contato para freelancer: (61) 99136-3695
On Error GoTo sai
If FileLen(caminhodoarquivo) > 0 Then ExisteArquivo = True
Exit Function
sai:
ExisteArquivo = False
End Function

Espero ter ajudado galera.

Se ficou como vc queria... não esqueça de colocar o tópico como resolvido e mandar um TKS.

Abraços

Espero ter ajudado.

Se ficou como vc queria... não esqueça de marcar essa mensagem como tópico resolvido e mandar um TKS.

Abraços

 
Postado : 13/09/2017 12:28 pm
(@leogranja)
Posts: 17
Active Member
Topic starter
 

Bom dia joebsb,

Funcionou perfeitamente!!! Muito obrigado!

Segue joinha!!

Leonardo Granja.

 
Postado : 14/09/2017 7:25 am