none
Enviar um e-mail em VBA com várias celulas no assunto RRS feed

  • Pergunta

  • Boa noite.

    Estou precisando mandar um e-mail automático para vários clientes onde solicito documentos onde cada um terá sua solicitação específica.

    EX: Cliente x

    Documentos:

    Documento 1

    Documento 2, etc.

    Estou usando o código abaixo, porém ele só permite enviar o conteúdo de uma célula:

    Sub MandaEmail()
        
        Dim EnviarPara As String
        Dim Mensagem As String
        For i = 1 To 10
            EnviarPara = ThisWorkbook.Sheets(1).Cells(i, 1)
            If EnviarPara <> "" Then
                Mensagem = ThisWorkbook.Sheets(1).Cells(i, 3) (aqui eu preciso que ele retorne no e-mail várias linhas dessa coluna)
                Envia_Emails EnviarPara, Mensagem
            End If
        Next i
    End Sub

    Sub Envia_Emails(EnviarPara As String, Mensagem As String)
        Dim OutlookApp As Object
        Dim OutlookMail As Object
        Set OutlookApp = CreateObject("Outlook.Application")
        Set OutlookMail = OutlookApp.CreateItem(0)
        With OutlookMail
            .To = EnviarPara
            .CC = ""
            .BCC = ""
            .Subject = "DOCUMENTOS CONTÁBEIS DA EMPRESA " + Range("D1").Text + " DO MÊS " + Range("E1").Text
            .Body = Mensagem
            .Display ' para envia o email diretamente defina o código  .Send
        End With
        Set OutlookMail = Nothing
        Set OutlookApp = Nothing
    End Sub

    Se alguém puder ajudar, agradeço.

    Jovacir

    quarta-feira, 5 de dezembro de 2018 20:14

Respostas

Todas as Respostas

  • opa meu amigo tudo bem ? faz assim :

    Por favor marca como respondido e vota pelo meu post , isso me ajuda, obrigado.

    Sub MandaEmail()
        
        Dim EnviarPara As String
        Dim Mensagem As String
        For i = 1 To 10
            EnviarPara = ThisWorkbook.Sheets(1).Cells(i, 1)
            If EnviarPara <> "" Then
               

    Mensagem=""

    for x= 1 to 100 '' aqui você escreve até que que célula quer que o o centeudo seja adiciona a mensagem

    Mensagem = Mensagem & " " & ThisWorkbook.Sheets(1).Cells(x, 3) 

    next x



                Envia_Emails EnviarPara, Mensagem
            End If
        Next i
    End Sub

    Sub Envia_Emails(EnviarPara As String, Mensagem As String)
        Dim OutlookApp As Object
        Dim OutlookMail As Object
        Set OutlookApp = CreateObject("Outlook.Application")
        Set OutlookMail = OutlookApp.CreateItem(0)
        With OutlookMail
            .To = EnviarPara
            .CC = ""
            .BCC = ""
            .Subject = "DOCUMENTOS CONTÁBEIS DA EMPRESA " + Range("D1").Text + " DO MÊS " + Range("E1").Text
            .Body = Mensagem
            .Display ' para envia o email diretamente defina o código  .Send
        End With
        Set OutlookMail = Nothing
        Set OutlookApp = Nothing
    End Sub



    quinta-feira, 6 de dezembro de 2018 02:16
  • Bom dia João. 

    Deu certo. Só há uma questão: fica tudo na mesma linha. Há como separar? Tipo, o que está em cada célula ficar em cada linha no e-mail?

    Ficou assim:

     Prezado (a),  Favor enviar os documentos abaixo referentes ao mês de 12/2018 da Empresa X para que possamos contabilizar:  Arquivo em Excel das Contas Pagas  no mês do Financeiro Relatórios/Extratos das vendas realizadas com cartões (Débito e Crédito) Extrato conta BANCO DO BRASIL - C/C xxxx - PDF E OFX Extrato conta  BANCO C.E.F - C/C xxxxx - PDF E OFX Departamento contábil 

    Queria assim:

     Prezado (a), 

    Favor enviar os documentos abaixo referentes ao mês de 12/2018 da Empresa X para que possamos contabilizar: 

    Arquivo em Excel das Contas Pagas  no mês do Financeiro

    Relatórios/Extratos das vendas realizadas com cartões (Débito e Crédito)

    Extrato conta BANCO DO BRASIL - C/C xxxx - PDF E OFX

    Extrato conta  BANCO C.E.F - C/C xxxxx - PDF E OFX

    Departamento contábil 

    Agradeço.

    quinta-feira, 6 de dezembro de 2018 12:25
  • substitua essa parte do codigo:

    por favor se isso te respondeu marque como resposta e vote pelo meu post , isso me ajuda e ajuda os outros usuários. obrigado amigo !

    Mensagem=""

    for x= 1 to 100 '' aqui você escreve até que que célula quer que o o centeudo seja adiciona a mensagem

    Mensagem = Mensagem & " " & ThisWorkbook.Sheets(1).Cells(x, 3) & chr(10) ' esse comendo faz a quebra de linha

    next x

    • Marcado como Resposta Jovacir Zanetti quinta-feira, 6 de dezembro de 2018 17:24
    • Não Marcado como Resposta Jovacir Zanetti quinta-feira, 6 de dezembro de 2018 17:25
    quinta-feira, 6 de dezembro de 2018 16:29
  • Deu super certo.

    Muito obrigado.

    • Marcado como Resposta Jovacir Zanetti quinta-feira, 6 de dezembro de 2018 17:26
    quinta-feira, 6 de dezembro de 2018 17:25