Jump to content

Enviar Mail Excel - Ajuda


Recommended Posts

Bom dia a todos nesta excelente comunidade!  😛

Vou iniciar o meu 2º post(o 1º foi a apresentação 🙂 ) com um pedido de ajuda.

Ora bem, tenho um ficheiro excel para registo de percentagens. Utilizo vários Vlookup's, que se reproduzem num range de várias linhas/colunas nas quais vou inserido os dados para serem verificados noutra sheet e devolvidos com o dado de outra coluna.

ex: =+VLOOKUP(B8;'Lista Total'!C$4:D$508;1;0)

      =+VLOOKUP(B9;'Lista Total'!C$4:D$508;1;0)

      =+VLOOKUP(B10;'Lista Total'!C$4:D$508;1;0)

E por aí fora...  😄

Por ultimo, tenho necessidado de ir enviar um mail que tem diferentes Cc's consoante o valor devolvido na coluna "J" que se reproduz por várias linhas.

Então arranjei esta formula para enviar mail:

=IF(J7="LX";HYPERLINK("mailto:"&C7&"?cc="&Conteudo_Mail!$B$2&"&subject="&K7&"&body="&Conteudo_Mail!B4&"%0D%0A"&"%0D%0A"&Conteudo_Mail!B5&"%0D%0A"&"%0D%0A"&"%0D%0A";"MAIL LX");(IF(J7="PT";HYPERLINK("mailto:"&C7&"?cc="&Conteudo_Mail!$B$3&"&subject="&K7&"&body="&Conteudo_Mail!B4&"%0D%0A"&"%0D%0A"&Conteudo_Mail!B5&"%0D%0A"&"%0D%0A"&"%0D%0A";"MAIL PT"))))

Tudo funciona bem, não fosse a limitação de caracteres no corpo do email. Que não é suficiente para todo o texto que preciso introduzir em cada mail.  🙂

Foi então que percebi que a alternativa seria o VBA (que não domino)  :wallbash:

Pedi ajuda num forum em Inglês e deram-me este código:

  
Sub Mail_small_Text_Outlook()
'Working in Office 2000-2010
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = Sheets("Conteudo_Mail").Range("B4").Value & vbCrLf & _
                vbCrLf & Sheets("Conteudo_Mail").Range("B5").Value & _
                vbCrLf & vbCrLf & vbCrLf

    On Error Resume Next
    With OutMail
        Select Case Range("J7").Value
            Case Is = "LX"
                .To = Range("C7").Value
                .CC = Sheets("Conteudo_Mail").Range("B2").Value
                .BCC = ""
                .Subject = Range("K7").Value
                .Body = strbody
            Case Is = "PT"
                .To = Range("C7").Value
                .CC = Sheets("Conteudo_Mail").Range("B3").Value
                .BCC = ""
                .Subject = Range("K7").Value
                .Body = strbody
            Case Else
                Exit Sub
        End Select
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub  

Ora bem, usando os meus esquecidos conhecimentos de VB6, até consigo entender minimamente as linhas de código. O problema passa por perceber como colcoar isto a funcionar na minha sheet  :wallbash:

Já activei a tab "developer"

E já colei o código no editor de visual basic (ou tenho de colar nas macros?), claro que nao acontece nada.. O que tenho de fazer? uma tecla de atalho? um botão?

Agradecimentos antecipados.  🙂

Link to comment
Share on other sites

No editor de VBA tens o Explorador do projecto, onde podes ver o livro e as folhas, assim como formulários, modulos de código e classes.

A forma mais fácil de colocares um procedimeno é num modulo. Para isso insere um e coloca o teu procedimento lá.

A partir do Excel vais a Macros e esse procedimento deverá aparecer lá, podendo ser executado.

Também podes inserir um botão e ligar o procedimento ao botão. Existem dois tipos de controlos: os controlos de formulário e os controlos ActiveX. 

Usa o botão de formulário, é mais simples, quando ele te pede a macro escolhe o teu procedimento.

O caminho mais curto para conseguir fazer muitas coisas é fazer uma de cada vez. Samuel Smiles

Link to comment
Share on other sites

No editor de VBA tens o Explorador do projecto, onde podes ver o livro e as folhas, assim como formulários, modulos de código e classes.

A forma mais fácil de colocares um procedimeno é num modulo. Para isso insere um e coloca o teu procedimento lá.

A partir do Excel vais a Macros e esse procedimento deverá aparecer lá, podendo ser executado.

Também podes inserir um botão e ligar o procedimento ao botão. Existem dois tipos de controlos: os controlos de formulário e os controlos ActiveX. 

Usa o botão de formulário, é mais simples, quando ele te pede a macro escolhe o teu procedimento.

Já segui as tuas indicações. Adicionei o Módulo, colei o Código (carreguei no run sub e nao deu erros), regressei à sheet e inseri um "button" de formulário escolhi o procedimento depois saio do "design mode" carrego no botão mas nada acontece.  ? O cursor do rato muda para modo de "leitura" durante algumas décimas de segundo e depois nada acontece.

Link to comment
Share on other sites

Provalmente o teu código é executado quando carregas no botão.

Mas para teres a certeza coloca uma mensagem(Msgbox "Texto") logo após a instrução .Send a informar que foi enviado, e outra antes do Exit Sub a informar que não pode ser enviado.

Em alternativa coloca um breakpoint no incio e faz depuração do código(F8).

O caminho mais curto para conseguir fazer muitas coisas é fazer uma de cada vez. Samuel Smiles

Link to comment
Share on other sites

Provalmente o teu código é executado quando carregas no botão.

Mas para teres a certeza coloca uma mensagem(Msgbox "Texto") logo após a instrução .Send a informar que foi enviado, e outra antes do Exit Sub a informar que não pode ser enviado.

Em alternativa coloca um breakpoint no incio e faz depuração do código(F8).

Ficou assim:

Sub Mail_small_Text_Outlook()
'Working in Office 2000-2010
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = Sheets("Conteudo_Mail").Range("B4").Value & vbCrLf & _
                vbCrLf & Sheets("Conteudo_Mail").Range("B5").Value & _
                vbCrLf & vbCrLf & vbCrLf

    On Error Resume Next
    With OutMail
        Select Case Range("J7").Value
            Case Is = "LX"
                .To = Range("C7").Value
                .CC = Sheets("Conteudo_Mail").Range("B2").Value
                .BCC = ""
                .Subject = Range("K7").Value
                .Body = strbody
            Case Is = "PT"
                .To = Range("C7").Value
                .CC = Sheets("Conteudo_Mail").Range("B3").Value
                .BCC = ""
                .Subject = Range("K7").Value
                .Body = strbody
            Case Else
                MsgBox "Não pode ser enviado"
                Exit Sub
        End Select
        .Send
         MsgBox "E-mail Enviado"
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Inseri um botão, e devolve-me a msg "E-mail Enviado".

Mas não envia...  :wallbash:

Link to comment
Share on other sites

Olá nupema,

com o teu código estás a fazer a "automation" do Outlook com técnica de "early binding".

se quiseres ler sobre o assunto vê p.e.

http://word.mvps.org/faqs/interdev/earlyvslatebinding.htm

ou tb. interressante

http://mateus.info/tecnologia/artigo2.html

em relação à tua questão experimenta fazer antes assim:

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

Presumo que fizeste a referenciação da dll do Outlook, em Tools->References...no IDE do VBA

João

Link to comment
Share on other sites

Olá nupema,

com o teu código estás a fazer a "automation" do Outlook com técnica de "early binding".

se quiseres ler sobre o assunto vê p.e.

http://word.mvps.org/faqs/interdev/earlyvslatebinding.htm

ou tb. interressante

http://mateus.info/tecnologia/artigo2.html

em relação à tua questão experimenta fazer antes assim:

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

Presumo que fizeste a referenciação da dll do Outlook, em Tools->References...no IDE do VBA

João

De facto, não tinha feito a referenciação da dll..  ?

Sub Mail_small_Text_Outlook()
'Working in Office 2000-2010
       
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

   .....

Com as alterações que sugeriste, dá-me a mesma indicação de ""E-mail Enviado".  B)

Já estive a dar uma leitura rápida nas paginas que sugeriste, mas logo em casa é que vou fazer uma leitura mais atenta. Percebi à partida entre outras coisas que é uma forma em que a execução do código corre de uma forma mais rápida..

Link to comment
Share on other sites

Alto lá.. funcionou!!!  😁

A primeira parte está assim concluída...  B)

Preciso apenas de adicionar mais uma função, a de procurar um pdf numa determinada pasta e a corresponder ao nome de uma determinada célula e anexa-lo ao email.. É possível?

E como posso colocar o código a funcionar com as diversas linhas, sem ter de estás a adicionar 200 botões ?  ?

Obrigado.

Link to comment
Share on other sites

   If FileFolderExists("F:\Test\TestWorkbook.xls") Then
        MsgBox "File exists!"
    Else
        MsgBox "File does not exist!"
    End If

O código seria qualquer coisa deste género, mas com um "if" em que caso o ficheiro existisse, fosse anexado ao Mail. o que acham? Como posso completar o código parra realizar o anexo?

Obrigado.

Link to comment
Share on other sites

Sub Mail_small_Text_Outlook() 
     'Working in Office 2000-2010
     
    Dim OutApp      As Outlook.Application 
    Dim OutMail     As Outlook.MailItem 
    Dim LRow        As Long 
    Dim i           As Long 
    Dim strBody     As String 
    Dim Pth         As String 
     
     
    Pth = "C:\AA\" '<==== Change to suit
    LRow = Cells(Rows.Count, 11).End(xlUp).Row 
     
    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 
     
    strBody = Sheets("Conteudo_Mail").Range("B5").Value & vbCrLf & _ 
    vbCrLf & Sheets("Conteudo_Mail").Range("B6").Value & _ 
    vbCrLf & vbCrLf & vbCrLf 
     
    On Error Resume Next 
     
    With OutMail 
        For i = 7 To LRow 
            If Cells(i, 1) <> "" Then '<====Change to suit
                Select Case Range("K" & i).Value 
                Case Is = "LX" 
                    .To = Range("D" & i).Value 
                    .CC = Sheets("Conteudo_Mail").Range("B2").Value 
                    .BCC = "" 
                    .Subject = Range("N" & i).Value 
                    .Body = strBody 'Sheets("Conteudo_Mail").Range("B5").Value
                    .Attachments.Add Pth & Dir(Pth & Range("G" & i) & ".pdf") 
                Case Is = "PT" 
                    .To = Range("D" & i).Value 
                    .CC = Sheets("Conteudo_Mail").Range("B3").Value 
                    .BCC = "" 
                    .Subject = Range("N" & i).Value 
                    .Body = strBody 'Sheets("Conteudo_Mail").Range("B5").Value
                    .Attachments.Add Pth & Dir(Pth & Range("G" & i) & ".pdf") 
                Case Else 
                    MsgBox "Não pode ser enviado" 
                    Exit Sub 
                End Select 
                .Display 
                MsgBox "E-mail Enviado - " & Range("D" & i).Value 
            End If 
        Next 
    End With 
    On Error Goto 0 
     
    Set OutMail = Nothing 
    Set OutApp = Nothing 
End Sub 

O que está aqui errado?

http://www.2shared.com/file/4GuplRJY/_Macro_Beta_.html

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.