Boa tarde tspiner,

Testei o seguinte código e funcionou bem. Não consegui implementar o código para verificar se o email foi enviado, mas caso não haja mensagem de erro suponho que o envio foi realizado, o que no entanto não significa que a pessoa recebeu/leu o email.

Sub teste_email()

Dim ObjOL As Object
Dim OlMail As Object
Dim Signature As String
Dim ultimalinha As Integer

Signature = CreateObject("Scripting.FileSystemObject").GetFile(Environ("AppData") & "\Microsoft\Signatures\INCLUA AQUI O NOME DA SUA ASSINATURA.txt").OpenAsTextStream(1, -2).readall 'Salva o conteúdo do arquivo .txt contendo a assinatura
CreateObject("Scripting.FileSystemObject").GetFile(Environ("AppData") & "\Microsoft\Signatures\INCLUA AQUI O NOME DA SUA ASSINATURA.txt").OpenAsTextStream(1, -2).Close 'Fecha o arquivo .txt contendo a assinatura
ultimalinha = Range("A2").End(xlDown).Row 'Verifica qual a última linha preenchida para determinar o limite superior do loop

For emails = 2 To ultimalinha
    Set ObjOL = CreateObject("Outlook.Application")
    Set OlMail = ObjOL.CreateItem(0)
    With OlMail
        .To = CStr(ThisWorkbook.Sheets("Send_Mails").Cells(emails, 1)) 'Preenche destinatário
        .CC = CStr(ThisWorkbook.Sheets("Send_Mails").Cells(emails, 2)) 'Preenche item CC
        .Subject = CStr(ThisWorkbook.Sheets("Send_Mails").Cells(emails, 4)) 'Preenche título do email
        .Body = CStr(ThisWorkbook.Sheets("Send_Mails").Cells(emails, 5)) & vbNewLine & vbNewLine & Signature 'Preenche o corpo do email e inclui a assinatura
        .Attachments.Add (CStr(ThisWorkbook.Sheets("Send_Mails").Cells(emails, 6))) 'Anexa o arquivo
        .Send 'Envia o email
    End With
Next emails
Set ObjOL = Nothing 'Limpa a variável
Set OlMail = Nothing 'Limpa a variável
End Sub

Att, Televisaos

Boa tarde, eu tenho esse código que funciona bem!

' INICIO DO E-MAIL.
Dim objOutlook As Object
Dim objNameSpace As Object
Dim objOlAccount As Object
Dim objMailItem As Object

On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0

If objOutlook Is Nothing Then
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
End If

Set objOlAccount = objOutlook.Session.accounts.Item(1)

Set objMailItem = objOutlook.CreateItem(0)

With objMailItem
Set .SendUsingAccount = objOlAccount

' .To = objOlAccount & "; endereç[email protected]; endereç[email protected]; " & Planilha07.[H10] 'Enviar para
.To = "Endereç[email protected]; endereç[email protected]; " & Planilha07.[H10] 'Enviar para
.CC = ""
.BCC = ""
.Subject = Planilha07.[H6] 'Titulo do email
.Body = Planilha07.[H7] & vbCrLf & " " & vbCrLf & Planilha07.[I7] _
& vbCrLf & " " & vbCrLf & "Obrigado!" 'Corpo do email

.Attachments.Add "C:\relato\" & Planilha07.[B10] & ".pdf" 'Anexo!
.Send
End With

Set objMailItem = Nothing
Set objOlAccount = Nothing
Set objNameSpace = Nothing
Set objOutlook = Nothing
' FINAL DO EMAIL

@televisaos obrigado meu amigo, vou testar aqui e depois te falo.  Uma dúvida, este seu código ele complementa o que ja existia na minha planilha ou posso coloca-lo como um novo código completo ? Se complementar, apartir de onde deveria colar no meu código?

@carlosrgs

obrigado meu amigo, vou testar aqui e depois te falo.  Uma dúvida, este seu código ele complementa o que ja existia na minha planilha ou posso coloca-lo como um novo código completo ? Se complementar, apartir de onde deveria colar no meu código?

Nesta minha planilha em anexo, o código é simples, pra mim que não saco muito do VBA, ao menos sei em quais celulas devem entrar as informações como e-mail a ser enviado, copiado, a mensagem e o anexo.  Podem me ajudar nesses códigos que informaram como eu montaria a planilha ?

Sub Send_Mails()
  Dim sh As Worksheet
  Set sh = ThisWorkbook.Sheets("Send_Mails")
  Dim i As Integer

  Dim OA As Object
  Dim msg As Object

  Set OA = CreateObject("outlook.application")

  Dim last_row As Integer
  last_row = Application.CountA(sh.Range("A:A"))

  For i = 2 To last_row
    Set msg = OA.createitem(0)
    msg.to = sh.Range("A" & i).Value
    msg.cc = sh.Range("B" & i).Value
    msg.Subject = sh.Range("D" & i).Value
    msg.body = sh.Range("E" & i).Value

    If sh.Range("F" & i).Value <> "" Then
      msg.attachments.Add sh.Range("F" & i).Value
    End If

    msg.send

    sh.Range("G" & i).Value = "Sent"

  Next i

  MsgBox "All the mails have been sent successfully"

End Sub

Editado pela Moderação. Motivo: Utilize o botão Código (< >) para inserir código VBA ou Fórmulas.

@tspiner Eu fiz o código como do zero mesmo.

1. @tspiner Seu código faz o mesmo que o meu porém sem adicionar a sua assinatura do outlook no final. Quanto à verificação de envio ele apenas mostra a mensagem de enviado com sucesso após o comando de enviar mas não puxa a propriedade .Sent para confirmar.

@televisaos amigo, boa noite!

sei que o post já está até ficando velho mas eu ainda não consegui uma solução.

Não consegui utilizar o seu código e nem o do amigo. 

Poderia me enviar em uma planilha já com o código ?

Tentei substituir o código do meu pelo seu código mas não funcionou.

E pra colocar em uma planilha nova eu não sei onde ficam os campos para colocar o email etc..

me ajuda nessa ai pf

Olá @tspiner,

Eu fiz o código com base no formato do arquivo que você anexou. Qual erro está aparecendo para você?

Att, Televisaos