Ir ao conteúdo
  • Cadastre-se
roneik

Ajuda - envio de e-mails por cdo

Recommended Posts

Bom dia a todos,

Tenho uma planilha para enviar e-mails que trabalha da seguinte forma até o momento:

existe uma tabela que na coluna "b" consta o nome de cada pessoa, na coluna "c" o e-mail de cada pessoa coluna "d" o endereço dos anexos e coluna "e" e "f" com os nomes dos arquivos.

Ela funciona, mas envia somente para 1 e-mail de cada pessoa e 1 anexo para cada pessoa, meu intuito era conseguir anexar mais arquivos e na coluna dos e-mails conseguir separar por "," e colocar mais e-mails.

encaminho abaixo os códigos e link da planilha.

link:

http://rapidshare.com/files/330073718/planemails.xlsm

módulo

Sub EnviarVariosEmails()
Dim objEmail As clsEmail
Dim sh As Worksheet
Dim vNomeTemp As Variant
Dim sNomeTo As String
Dim sAnexoTo As String
Dim sEmailTo As String
Dim sStatus As String
Dim iLinhaInicial As Long
Dim iLinhaFinal As Long
Dim i As Long

On Error GoTo Erro_Sub

Set objEmail = New clsEmail 'Inicializa a classe clsEmail
Set sh = Sheets("PlanListaDeEmails") 'Define a planilha

With objEmail
.setConfEmailServidor = "smtp.gmail.com" 'Servidor de saída de emails. Ex: smtp.uol.com.br
.setConfEmailPorta = "465" 'Porta. Padrão é a porta 25
.setConfEmailSSL = True 'Se necessita conexão segura SSL
.setConfEmailFrom = "roneikotz@gmail.com" 'Seu email: O remetente do email. Ex: seunome@uol.com.br
.setConfEmailSenha = "xxxxxxxxx" 'Sua senha: A senha que você usa para acessar seus emails
.setConfEmailFromNome = "Ronei Kotz" 'Seu nome: O nome que será exibido no campo De:
.Configurar 'Executa a configuração

'Percorre a listagem de emails para enviar
iLinhaInicial = 8 'Informe a linha que começa a lista de emails
iLinhaFinal = sh.Range("A1").SpecialCells(xlCellTypeLastCell).Row 'Recupera automaticamente a última linha da tabela

For i = iLinhaInicial To iLinhaFinal
Application.StatusBar = "Enviando email " & (i - iLinhaInicial + 1)

sNomeTo = Trim(sh.Range("B" & i))
sEmailTo = Trim(sh.Range("C" & i))
sAnexoTo = Trim(sh.Range("D" & i)) & Trim(sh.Range("E" & i)) & ".pdf"

If Len(sEmailTo) = 0 Then 'Verifica se o email do destinatário foi informado
sStatus = "Informe o email do destinatário."
Else
If Len(sNomeTo) = 0 Then 'Verifica se um nome foi informado
vNomeTemp = Split(sEmailTo, "@")
sNomeTo = vNomeTemp(0)
End If

.setEmailTo = sEmailTo 'Email do Destinatário
.setEmailToNome = sNomeTo 'Nome do Destinatário

.setEmailTitulo = "teste" 'Título da mensagem

'Aqui, você deve digitar o conteúdo. Pode utilizar formatação HTML.
.setEmailConteudo = "" & .getEmailToNome & ".Segue em anexo "

.setEmailAnexo = sAnexoTo
.EnviarEmail

sStatus = "Email enviado com sucesso!"
.setEmailAnexo = "sAnexoTo"

End If

sh.Range("g" & i) = sStatus 'Escreve o status do envio
Next i

End With

Set objEmail = Nothing
Set sh = Nothing

Application.StatusBar = False
MsgBox "Emails enviados", vbInformation

Exit Sub
Erro_Sub:
MsgBox Err.Description, vbExclamation
Exit Sub
End Sub

módulo de classe clsEmail

Sub EnviarVariosEmails()
Dim objEmail As clsEmail
Dim sh As Worksheet
Dim vNomeTemp As Variant
Dim sNomeTo As String
Dim sAnexoTo As String
Dim sEmailTo As String
Dim sStatus As String
Dim iLinhaInicial As Long
Dim iLinhaFinal As Long
Dim i As Long

On Error GoTo Erro_Sub

Set objEmail = New clsEmail 'Inicializa a classe clsEmail
Set sh = Sheets("PlanListaDeEmails") 'Define a planilha

With objEmail
.setConfEmailServidor = "smtp.gmail.com" 'Servidor de saída de emails. Ex: smtp.uol.com.br
.setConfEmailPorta = "465" 'Porta. Padrão é a porta 25
.setConfEmailSSL = True 'Se necessita conexão segura SSL
.setConfEmailFrom = "roneikotz@gmail.com" 'Seu email: O remetente do email. Ex: seunome@uol.com.br
.setConfEmailSenha = "xxxxxxxxx" 'Sua senha: A senha que você usa para acessar seus emails
.setConfEmailFromNome = "Ronei Kotz" 'Seu nome: O nome que será exibido no campo De:
.Configurar 'Executa a configuração

'Percorre a listagem de emails para enviar
iLinhaInicial = 8 'Informe a linha que começa a lista de emails
iLinhaFinal = sh.Range("A1").SpecialCells(xlCellTypeLastCell).Row 'Recupera automaticamente a última linha da tabela

For i = iLinhaInicial To iLinhaFinal
Application.StatusBar = "Enviando email " & (i - iLinhaInicial + 1)

sNomeTo = Trim(sh.Range("B" & i))
sEmailTo = Trim(sh.Range("C" & i))
sAnexoTo = Trim(sh.Range("D" & i)) & Trim(sh.Range("E" & i)) & ".pdf"

If Len(sEmailTo) = 0 Then 'Verifica se o email do destinatário foi informado
sStatus = "Informe o email do destinatário."
Else
If Len(sNomeTo) = 0 Then 'Verifica se um nome foi informado
vNomeTemp = Split(sEmailTo, "@")
sNomeTo = vNomeTemp(0)
End If

.setEmailTo = sEmailTo 'Email do Destinatário
.setEmailToNome = sNomeTo 'Nome do Destinatário

.setEmailTitulo = "teste" 'Título da mensagem

'Aqui, você deve digitar o conteúdo. Pode utilizar formatação HTML.
.setEmailConteudo = "" & .getEmailToNome & ".Segue em anexo "

.setEmailAnexo = sAnexoTo
.EnviarEmail

sStatus = "Email enviado com sucesso!"
.setEmailAnexo = "sAnexoTo"

End If

sh.Range("g" & i) = sStatus 'Escreve o status do envio
Next i

End With

Set objEmail = Nothing
Set sh = Nothing

Application.StatusBar = False
MsgBox "Emails enviados", vbInformation

Exit Sub
Erro_Sub:
MsgBox Err.Description, vbExclamation
Exit Sub
End Sub

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×