[Resolvido]Enviar relatório por e-mail anexo e como mensagem no corpo

Olá pessoal,

Estou criando uma BD de controle na emissão de etiquetas, a qual preciso criar um botão de envio no proprio relatório.
Até aí tudo bem, eu consigo enviar o relatório em anexo, mas o dilema está em criar um código VBA que o faça ser enviado também no corpo do email em formato HTML.

Alguém tem alguma sugestão de código para compartilhar.
Abaixo o código:

Private Sub SendEmail_Click()

Dim strArquivo  As String
Dim strLocal    As String
Dim objOut      As Object
Dim objmail     As Object
Dim objAnexo    As Object
Const olMailItem = 0
Const olByValue = 1


'Set objOut = CreateObject("Outlook.application")

Set objmail = objOut.CreateItem(olMailItem)

'------------------------------------------------------------
'Abrindo a opção anexo
'Similar ao clicar no botão ANEXO do Outlook
'------------------------------------------------------------
Set objAnexo = objmail.Attachments

'---------------------------------------------------------------------------------
'---------------------------------------------------------------------------------
strArquivo = Replace(Me!Relato, "/", "_") & " .pdf"
strLocal = CurrentProject.Path & "\enviados\" & strArquivo

'Salvando alterações no registro
If Me.Dirty Then DoCmd.RunCommand acCmdSaveRecord

DoCmd.OpenReport "TesteRFuncionario", acViewPreview, acHidden

DoCmd.Close acReport, "TesteRFuncionario"

'--------------------------------------------------------
'adiciona o arquivo pdf no anexo
'-------------------------------------------------------
objAnexo.Add strLocal, olByValue, 1
objmail.To = "Dias, Ever J.P."
objmail.CC = "Paiva, Monica K.N"
objmail.Subject = "Relatório"



objmail.Display


Set objAnexo = Nothing
Set objmail = Nothing
Set objOut = Nothing

End Sub

Fabrícia, passei pelo mesmo problema e a minha solução foi criar parte do condigo em HTML. E no objeto email tem uma propriedade HTMLBody que escreve no corpo do email neste formato, veja um parte do código empregado.

Código:

       corpo = corpo & "<b>Prezado(a)</b>"
       corpo = corpo & "<p>Comunicamos que o vencimento referente ao boleto </p>"
       corpo = corpo & "<p><b>" & Format(DLookup("Folha", "tbl_Folha"), "mm/yyyy") & "</b> relacionado ao serviços junto </p><p>ao Grupo Sistem & Well prestados a Sr(a)." & destinatario & " será <b>" & dt & "</b>.</p>"
       corpo = corpo & "<p>Segue abaixo dados para pagamento:</p>
       corpo = corpo & "<p><b>Banco: " & Banco & "</b> </p>"
       corpo = corpo & "<p><b>Agência: " & Agencia & "</b></p>"
       corpo = corpo & "<p><b>Favorecido: " & Favorecido & "</b></p>"
       corpo = corpo & "<p><b>CNPJ: " & CNPJ & "</b></p>"
       corpo = corpo & "<br>"
       corpo = corpo & "<p>Qualquer dúvida estamos a disposição.</p>"
       corpo = corpo & "<p>Cordialmente,</p>"

With Mens
     Set objOutlookRec = .Recipients.Add("email@com.br")
    .To = textoI
    .Subject = assunto
    .HTMLBody = corpo
    .Display
    '.Send
End With

Muito bom mesmo...

Vou testar aqui!

Não consigo adptar ao meu código, será que necessita de alguma função pra ele funcionar?

Avelino é muito bom seu exemplo.
mas a minha necessidade é adaptar esse código ao botão enviar sem o formulario de envio.

Fabricia, a sugestão do mestre Avelino, cabe melhor na sua necessidade... Tente aplicá-la e qualquer dúvida reporte ao fórum.

Eu consegui adpatar.
Funcionou perfeitamente o anexo no corpo do email.
Mas no meu BD esta dando erro no codigo abrir anexos com a mensagem "O tipo definido pelo usuario, nao foi definido".

Só pra finalizar, me ajuda Avelino.

Public Function fncLocalizarArquivo()
Dim fd As Office.FileDialog
On Error GoTo trataerro
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
With .Filters
.Clear
'.Add "Banco de Dados", "*.accdb", 1
.Add "Todos", "*.*", 1
End With
.Title = "Selecionar Banco de Dados)"
.AllowMultiSelect = False
.InitialFileName = "c:\"
.InitialView = msoFileDialogViewPreview
If .Show Then
fncLocalizarArquivo = .SelectedItems(1)
End If
End With
sair:
Exit Function
trataerro:
fncLocalizarArquivo = ""
Resume sair:
End Function

Obrigado muito útil...