Envio E-mail Outlook - Vários E-mails Copias

Prezados, boa tarde!


Estou montado uma automação para enviar e-mails através do outlook, já consegui conforme código abaixo porém preciso enviar com cópias para diversos e-mails.

Problema: Enviar para mais de um e-mail como cópia.


Dim OutApp As Object
Dim OutMail As Object
Dim conteudo2 As String

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

assunto = "teste"
conteudo = "Prezados!!"

'E-mail principal
emails = "vinicius@gmail.com"


With OutMail
.To = emails
.Subject = assunto
.CC = "vinicius@gmail.com" 'cópia do e-mail
.Body = conteudo
.Send
End With

'objOutlookMsg.Send

Set OutApp = Nothing
Set OutMail = Nothing
Set OutApp = Nothing


Obs: Já pesquisei no fórum e não achei.

tente assim:

crie uma tabela com o nome tbl_email
crie duas colunas do tipo texto longo ou memorando
(Para_enviar) e a outra (com_copia)

cadastre seus e-mail's na primeira linha dessa tabela lembrando a regra de enviar para mais de um e-mail
ex: fulando@algumacoisa.com; jose.silva@hotmail.com; zemaria@bol.com.br

'insira no seu codigo inicial essas variaveis para buscar sua lista

Dim enviarto, enviarcc As String

enviarto = Nz(DLookup("Para_enviar", "tbl_email"), "-")
enviarcc = Nz(DLookup("com_copia", "tbl_email"), "-")

Dim OutApp As Object
Dim OutMail As Object
Dim conteudo2 As String

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

assunto = "teste"
conteudo = "Prezados!!"

'E-mail principal
'emails = "vinicius@gmail.com"

'chamar as string inseridas acima

With OutMail
.To = enviarto
.Subject = assunto
.CC = enviarcc
.Body = conteudo
.Send
End With

'objOutlookMsg.Send

Set OutApp = Nothing
Set OutMail = Nothing
Set OutApp = Nothing

conseguiu?