Boa tarde amigos,
Editei alguns exemplos que achei para realizar o envio de e-mails automáticos incluindo alguns anexos, porém não obtive sucesso.
Poderiam dizer o que há de errado com meu código? Desde já agradeço!
Editei alguns exemplos que achei para realizar o envio de e-mails automáticos incluindo alguns anexos, porém não obtive sucesso.
Poderiam dizer o que há de errado com meu código? Desde já agradeço!
- Código:
Private Sub Comando71_Click()
Dim escritorio As String
Dim mensagem As String
Dim email As Object
Dim appOutlook As Object
Dim olMail As Object
Dim rst As DAO.Recordset
Dim strDestinatarios
Beep
If MsgBox("Deseja Enviar o e-mail? Não esqueça de deixar o outlook aberto!", vbInformation + vbYesNo, "Atenção") = vbYes Then
'Verifica se Outlook está aberto. Caso não esteja, criar nova instância
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0
'0 é um item de e-mail
Set olMail = appOutlook.CreateItem(0)
'Define o nome da consulta onde estarão cadastrados os emails autorizados
Set rst = CurrentDb.OpenRecordset("Cs_Emails_Autorizados")
Do Until rst.EOF
strDestinatarios = strDestinatarios & rst("eMail") & ";"
rst.MoveNext
Loop
strDestinatarios = Left(strDestinatarios, Len(strDestinatarios) - 1)
'Select Case escritorio
' Case "ANTONIO"
With olMail
.To = "gabriel.p.lisboa@outlook.com"
.CC = "vg.cordeiro@outlook.com"
.Subject = "E-mail 1 - ANTONIO FERNANDO DE SOUZA E GARCIA DE SOUZA A - PR"
.Body = "Bom dia, segue anexo referente a email automatizado 1" & " " & Date & " - " & Time()
.Attachments.Add CurrentProject.Path & "\Export\ANTONIO.xlsm"
End With
Case "AREAS"
With olMail
.To = "gabriel.p.lisboaoutlook.com"
.CC = "vg.cordeiro@outlook.com"
.Subject = "E-mail 2 - AREAS ASSESSORIA JURIDICA"
.Body = "Bom dia, segue anexo referente a email automatizado 2" & " " & Date & " - " & Time()
.Attachments.Add CurrentProject.Path & "\Export\ARÊAS.xlsm"
End With
Case "BASILIO"
With olMail
.To = "gabriel.p.lisboaoutlook.com"
.CC = "vg.cordeiro@outlook.com"
.Subject = "E-mail 3 - BASILIO, DI MARINO E FARIA ADVOGADOS - RJ"
.Body = "Bom dia, segue anexo referente a email automatizado 3" & " " & Date & " - " & Time()
.Attachments.Add CurrentProject.Path & "\Export\BASILIO.xlsm"
End With
Case Else
MsgBox "Email não enviado!"
End Select
Else: GoTo saída
rst.Close
Set rst = Nothing
End If
saída: Exit Sub
MsgBox "E-mails enviados com sucesso!", vbInformation
End Sub