[Ajuda] Planilha envio de Relatorio por e-mails

[rogerio.campos]

Prezados,

Gostaria da ajuda com uma planilha que criei do zero. Desde já informo que sou apenas um entusiasta com relação a Excel e VBA por isso do meu pedido de ajuda.

Tenho uma planilha que uso para manter um cadastro de parceiros e nesta mesma planilha tenho um histórico mensal de valores por parceiro e este valores compõem um relatório que eu envio por e-mail mensalmente. Hoje a planilha tem mais ou menos uns 110 cadastros e a ideia é chegar a no máximo 500.
O que preciso é de alguém que possa me ajudar/orientar quanto criar a macro de envio de e-mails individuais (cada cadastro esta numa planilha diferente dentro de um arquivo .XMLS. Hoje eu tenho uma Macro que envia e-mail contudo eu tenho um grande trabalho para tratar os dados mês a mês porque a forma de envio é por string.
Obviamente estou aberto a sugestões de melhorias etc, como eu disse sou uma amador em relação a excel e vba.
Devido a confidencialidade das informações contidas no arquivo eu não vou posta-lo aqui contudo disponibilizarei para aqueles que se dispuserem a ajudar.

desde já agradeço a atenção de todos.

[Raygsson]

Rogerio
Um comando simples para fazer um loop em todas as planilhas/cadastros seria algo como isto:

Código: Selecionar todos

For Each plan In ThisWorkbook.Sheets
  
Next

Mostre como esta o seu codigo na parte referente ao carregamento/envio do email.

[rogerio.campos]

Hoje utilizo o código abaixo, porem ele faz o envio de informações por string conforme a variável "Mensagem". Meu arquivo tem diversas planilhas (uma para cada cadastro) que por si só ja é complicado de manusear devido a quantidade de cadastros e ai preciso enviar um relatório que tem dentro destas planilhas. Caso queria posso ceder a planilha por e-mail.

Sub MandaEmail()

Dim EnviarPara As String
Dim Mensagem As String
For i = 1 To 1
EnviarPara = ThisWorkbook.Sheets(1).Cells(i, 3)
If EnviarPara <> "" Then
Mensagem = ThisWorkbook.Sheets(1).Cells(i, 1) & vbNewLine & vbNewLine & ThisWorkbook.Sheets(1).Cells(i, 4) & vbNewLine & vbNewLine & ThisWorkbook.Sheets(1).Cells(i, 5) & vbNewLine & ThisWorkbook.Sheets(1).Cells(i, 6) & vbNewLine & ThisWorkbook.Sheets(1).Cells(i, 7) & vbNewLine & vbNewLine & vbNewLine & ThisWorkbook.Sheets(1).Cells(i, 18)

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
.Display
.To = EnviarPara
.CC = ""
.BCC = "pos@b.com.br"
.Subject = "Relatório "
.Body = Mensagem
.Display ' para envia o email diretamente defina o código .Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub