Bom-dia

Tenho um código que baixei para enviar vários emails via "SMTP", teria como configurar para enviar via "IMAP" !?

Public Sub lsEnviar()
Dim iMsg, iConf, Flds
Dim lUltimaLinhaAtiva As Long
Dim lLinha As Long
Dim lPeriodoIni As Date
Dim lPeriodoFim As Date
Dim lAniversario As Date

Application.ScreenUpdating = False

lUltimaLinhaAtiva = Worksheets("Lista").Cells(Worksheets("Lista").Rows.Count, 1).End(xlUp).Row

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields

'Configura o componente de envio de email
schema = " http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(schema & "sendusing") = 2
'Configura o smtp
Flds.Item(schema & "smtpserver") = Range("smtp").Value
'Configura a porta de envio de email
Flds.Item(schema & "smtpserverport") = Range("port").Value
Flds.Item(schema & "smtpauthenticate") = IIf(Range("Autenticar").Value = "Sim", 1, 0)
'Configura o email do remetente
Flds.Item(schema & "sendusername") = Range("email").Value
'Configura a senha do email remetente
Flds.Item(schema & "sendpassword") = Range("senha").Value
Flds.Item(schema & "smtpusessl") = IIf(Range("SSL").Value = "Sim", 1, 0)
Flds.Update

For lLinha = 2 To lUltimaLinhaAtiva
lPeriodoIni = Range("PerIni").Value
lPeriodoFim = Range("PerFim").Value
lAniversario = Sheets("Lista").Range("B" & lLinha).Value

If (Month(lAniversario) >= Month(lPeriodoIni) And Day(lAniversario) >= Day(lPeriodoIni)) _
And (Month(lAniversario) <= Month(lPeriodoFim) And Day(lAniversario) <= Day(lPeriodoFim)) Then
With iMsg
'Email do destinatário
.To = Sheets("Lista").Range("C" & lLinha).Value
'Seu email
.From = Range("email").Value
'Cópia do e-mail
.CC = Range("copia").Value
'Título do email
.Subject = Range("titulo").Value & " " & Sheets("Lista").Range("A" & lLinha).Value
'Mensagem do e-mail, você pode enviar formatado em HTML
.HTMLBody = Range("Mensagem").Value
'Seu nome ou apelido
.Sender = Range("Nome").Value
'Nome da sua organização
.Organization = Range("Empresa").Value
'email de responder para
.ReplyTo = Range("email").Value
'Anexo a ser enviado na mensagem
'.AddAttachment ("c:rieperDicas VBA.docx")
'Passa a configuração para o objeto CDO
Set .Configuration = iConf
'Envia o email
.Send
End With
End If
Next lLinha

'Limpa as variáveis
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing

Application.ScreenUpdating = True

MsgBox "E-mails enviados!"
End Sub

Att,

Francisco