Código para envio automático via GMAIL (funcionava, mas parou)
Enviado: 09 Jul 2021 às 21:31
Boa noite a todos.
Estou com um problema com esta macro para o envio de e-mails automáticos via gmail.
Ela já funcionou comigo duas vezes, mas não sei o que aconteceu, não está rolando. Verifiquei as configurações do GMAIL e está tudo certo. Podem me ajudar?
Substitui o password e o e-mail por razões óbvias.
Dim IMsg, IConf, Flds
Set IMsg = CreateObject("CDO.Message")
Set IConf = CreateObject("CDO.Configuration")
Set Flds = IConf.Fields
schema = "http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(schema & "sendusing") = 2
Flds.Item(schema & "smtpserver") = "smtp.gmail.com"
Flds.Item(schema & "smtpserverport") = 465
Flds.Item(schema & "smtpauthenticate") = 1
Flds.Item(schema & "sendusername") = "e-mail institucional"
'na linha de baixo, você pode definir o password em uma célula para ele puxar, como exemplo, ou você pode escrever direto'
Flds.Item(schema & "sendpassword") = "password do e-mail"
Flds.Item(schema & "smtpusessl") = 1
Flds.Update
With IMsg
'células contendo os e-mails'
.To = Cells(aux, 2)
.From = "e-mail institucional@ufsj.edu.br"
'Assunto do e-mail'
.Subject = "Certificado de Participação - 2ª Palestra do GHAP"
'mensagem do e-mail'
.HTMLBody = "<H1> "Corpo da mensagem"
.Organization = "GHAP - Grupo de Pesquisa em Geografia Humana Aplicada"
.ReplyTo = "ghap@ufsj.edu.br"
'Substituir o caminho para o arquivo a ser anexado'
.AddAttachment "caminho\" & Cells(aux, 1) & ".pdf"
Set .Configuration = IConf
.Send
End With
Next aux
End Sub
Estou com um problema com esta macro para o envio de e-mails automáticos via gmail.
Ela já funcionou comigo duas vezes, mas não sei o que aconteceu, não está rolando. Verifiquei as configurações do GMAIL e está tudo certo. Podem me ajudar?
Substitui o password e o e-mail por razões óbvias.
Dim IMsg, IConf, Flds
Set IMsg = CreateObject("CDO.Message")
Set IConf = CreateObject("CDO.Configuration")
Set Flds = IConf.Fields
schema = "http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(schema & "sendusing") = 2
Flds.Item(schema & "smtpserver") = "smtp.gmail.com"
Flds.Item(schema & "smtpserverport") = 465
Flds.Item(schema & "smtpauthenticate") = 1
Flds.Item(schema & "sendusername") = "e-mail institucional"
'na linha de baixo, você pode definir o password em uma célula para ele puxar, como exemplo, ou você pode escrever direto'
Flds.Item(schema & "sendpassword") = "password do e-mail"
Flds.Item(schema & "smtpusessl") = 1
Flds.Update
With IMsg
'células contendo os e-mails'
.To = Cells(aux, 2)
.From = "e-mail institucional@ufsj.edu.br"
'Assunto do e-mail'
.Subject = "Certificado de Participação - 2ª Palestra do GHAP"
'mensagem do e-mail'
.HTMLBody = "<H1> "Corpo da mensagem"
.Organization = "GHAP - Grupo de Pesquisa em Geografia Humana Aplicada"
.ReplyTo = "ghap@ufsj.edu.br"
'Substituir o caminho para o arquivo a ser anexado'
.AddAttachment "caminho\" & Cells(aux, 1) & ".pdf"
Set .Configuration = IConf
.Send
End With
Next aux
End Sub