Access 2013 - Enviar Relatório com anexo pelo Outoolk

Quanto tento enviar um e-mail através do macro, usando o Outolook com envio direto ele aparece esta mensagem de erro.
Quanto tento enviar Editar mensagem Sim (Ou seja ele não envia direto) funciona tudo bem.
Como enviar direto o email, está faltando algo.
Sou Novato.




Ação:EnviarObjetodeBancodeDadosporEMail


***************************************************
// Conversão do Macro para VBA.
Option Compare Database

'------------------------------------------------------------
' Macro12
'
'------------------------------------------------------------
Function Macro12()
On Error GoTo Macro12_Err

   DoCmd.SendObject acReport, "Movimento", "PDFFormat(*.pdf)", "contato@contalsoft.com.br", "", "", "Favor Verifique os Saldo Negativo das contas", "Verifique o arquivo", True, ""


Macro12_Exit:
   Exit Function

Macro12_Err:
   MsgBox Error$
   Resume Macro12_Exit

End Function

Boa dia,

Eu tenho o código abaixo implementado numa BD minha e está a funcionar 5 *****.
Adapte a sua BD.

Private Sub Command49_Click()
Dim appOutlook As Object
Dim olMail As Object
Dim strArquivo As String
Dim strLocal As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
strArquivo = "Nome que quer dar ao seu PDF "&".pdf"
strLocal = CurrentProject.Path & "\PDF\" & strArquivo 'Cria uma pasta junto a sua BD chamado "PDF" para guardar os seus PDF criados.
DoCmd.OutputTo acOutputReport, "Seu relatório para PDF", acFormatPDF, strLocal
'Verifica se Outlook está aberto. Caso não esteja, criar nova instância
On Error Resume Next
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0

Set olMail = appOutlook.CreateItem(0) '0 é um item de e-mail

With olMail
.To = "teste@hotmail.com"
.CC = ""
.Subject = "Assunto"
If Not IsNull(strLocal) Then
.Attachments.Add (strLocal)
End If
'.Attachments.Add ("Caminho onde está seu ficheiro PDF para anexar")
.Body = "Aqui escreve mensagem corpo email"
'.SaveAs ("Caminho para guardar email se assim o desejar")
.Send 'Se trocar ".Send" por ".Display" ele mostra email antes de enviar
End With
MsgBox "Email@ enviado com sucesso." , vbInformation, "Email"
End Sub


Qualquer duvida disponha....

Bom com a liberação ocorreu tudo ok.
Mas esta aparecendo esta mensagem.
Quando permito ele mandar.
Alguém saber como liberar.

Qual aplicação que voçe tem para enviar email?
Outlook?

Veja nas opçoes de segurança do seu Outlook....
Não se esqueça de alterar nome do relátorio no código que postei, e nome de email(".To:"). Cria tambem pasta "PDF" junto a sua BD.

Abraço...

Alguém tem alguma solução sem ser macro do amigo é para buscar um arquivo
Gostaria de enviar o relatório transforma-lo em pdf e depois anexo via email direto.

Arquivo anexo:

Bom estou vendo que terei problema.
Pois vou enviar esta aplicação para outra pessoa.
E preciso de enviar sem passar pelo Outlook com anexo.
Existe algum exemplo.

Caso exista enviar para mim. Ou coloque neste modelo que estou enviado. Por favor,

Eu tenho este código e funciona perfeitamente:

Código:

Private Sub Comando698_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


'---------------------------------------------
'Carregando a coleção do Outlook
'Similar ao abrir o Outlook
'---------------------------------------------
Set objOut = CreateObject("Outlook.application")

'------------------------------------------------------------
'Abrindo o formulário de email para inserir os itens de email
'Similar ao clicar no botão NOVO do Outlook
'------------------------------------------------------------
Set objmail = objOut.CreateItem(olMailItem)

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

'---------------------------------------------------------------------------------
'Indico o nome do arquivo pdf e o local que será gravado
'O local que escolhi para gravar os arquivos de pdf gerados
'é na pasta enviados, aonde se encontra o aplicativo.
'Neste exemplo, gero os nomes dos arquivos, aproveitando o número exclusivo
'do cliente.  Então os arquivos vão ficar com o aspecto: rlt1.pdf, rlt2.pdf, ...
'É claro que vc poderá gerar o nome que achar mais conveniente.
'---------------------------------------------------------------------------------
strArquivo = Replace(Me!cam7, "/", "_") & Replace(Me!CaixaCombinação720, "/", "_") & " _ " & Me![001] & ".pdf"
strLocal = CurrentProject.Path & "\Oficios\Oficios Expedidos\" & strArquivo

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

'----------------------------------------------------------------------------
'Abre o relatório filtrado e oculto de acordo com o cliente selecionado.
'----------------------------------------------------------------------------
DoCmd.OpenReport "OficioNovo", acViewPreview, , "[001] = " & [001], acHidden

'----------------------------------------------------------------------------------------
'gero o pdf do relatório através do comando outputto.
'o mecanismo do Access reconhece que o relatório solicitado pelo outputto já está aberto
'e então o outputto usará o relatório já aberto e filtrado.
'-----------------------------------------------------------------------------------------
DoCmd.OutputTo acOutputReport, "OficioNovo", acFormatPDF, strLocal
'-------------------------------------------
'fecha o relatório clientes que está oculto
'-------------------------------------------
DoCmd.Close acReport, "OficioNovo"

'--------------------------------------------------------
'adiciona o arquivo pdf no anexo
'-------------------------------------------------------
objAnexo.Add strLocal, olByValue, 1

'-----------------------------------------------------------------
'Mostra a tela de sáida de email que abrimos
'-----------------------------------------------------------------
objmail.Display


'-------------------------------------------------------
'Tudo já foi entregue ao outlook, então podemos esvaziar
'a memoria do computador usada pelas variáveis
'-------------------------------------------------------
Set objAnexo = Nothing
Set objmail = Nothing
Set objOut = Nothing
End Sub

Tenho esse que também imprime:

Código:

Private Sub Comando697_Click()
Dim strArquivo  As String
Dim strLocal    As String
Dim objOut      As Object
Dim objmail    As Object
Dim objAnexo    As Object
Dim bytVias, bytLoop As Byte
Const olMailItem = 0
Const olByValue = 1


'---------------------------------------------
'Carregando a coleção do Outlook
'Similar ao abrir o Outlook
'---------------------------------------------
Set objOut = CreateObject("Outlook.application")

'------------------------------------------------------------
'Abrindo o formulário de email para inserir os itens de email
'Similar ao clicar no botão NOVO do Outlook
'------------------------------------------------------------
Set objmail = objOut.CreateItem(olMailItem)

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

'---------------------------------------------------------------------------------
'Indico o nome do arquivo pdf e o local que será gravado
'O local que escolhi para gravar os arquivos de pdf gerados
'é na pasta enviados, aonde se encontra o aplicativo.
'Neste exemplo, gero os nomes dos arquivos, aproveitando o número exclusivo
'do cliente.  Então os arquivos vão ficar com o aspecto: rlt1.pdf, rlt2.pdf, ...
'É claro que vc poderá gerar o nome que achar mais conveniente.
'---------------------------------------------------------------------------------
strArquivo = Replace(Me!cam7, "/", "_") & Replace(Me!CaixaCombinação720, "/", "_") & " _ " & Me![001] & ".pdf"
strLocal = CurrentProject.Path & "\Oficios\Oficios Expedidos\" & strArquivo

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

'----------------------------------------------------------------------------
'Abre o relatório filtrado e oculto de acordo com o cliente selecionado.
'----------------------------------------------------------------------------
DoCmd.OpenReport "OficioNovo", acViewPreview, , "[001] = " & [001], acHidden

'----------------------------------------------------------------------------------------
'gero o pdf do relatório através do comando outputto.
'o mecanismo do Access reconhece que o relatório solicitado pelo outputto já está aberto
'e então o outputto usará o relatório já aberto e filtrado.
'-----------------------------------------------------------------------------------------
DoCmd.OutputTo acOutputReport, "OficioNovo", acFormatPDF, strLocal
Dim numCop As Integer
    numCop = InputBox("Informe a quantidade de cópias: ", "IMPRIMIR") 'Valor este que pode ser obtido por outro meios
    DoCmd.PrintOut acPrintAll, , , acHigh, numCop 'Linha simplificada para a impressão

'-------------------------------------------
'fecha o relatório clientes que está oculto
'-------------------------------------------
DoCmd.Close acReport, "OficioNovo"

'--------------------------------------------------------
'adiciona o arquivo pdf no anexo
'-------------------------------------------------------
objAnexo.Add strLocal, olByValue, 1

'-----------------------------------------------------------------
'Mostra a tela de sáida de email que abrimos
'-----------------------------------------------------------------
objmail.Display


'-------------------------------------------------------
'Tudo já foi entregue ao outlook, então podemos esvaziar
'a memoria do computador usada pelas variáveis
'-------------------------------------------------------
Set objAnexo = Nothing
Set objmail = Nothing
Set objOut = Nothing
End Sub

Tenho na bd ainda um módulo para chamar a função com o nome "Email" nãosei se é necessário na altura coloquei ma já não me recordo qual o motivo

Código:

Private Declare Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" (ByVal hwnd As Long, _
  ByVal lpOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory _
  As String, ByVal nShowCmd As Long) As Long

Private Const SW_SHOWNORMAL = 1

Public Sub GoToMyWebPage(frm As Form, sUrl As String)

Dim lRet As Long
lRet = ShellExecute(frm.hwnd, "open", sUrl, _
        vbNull, vbNullString, SW_SHOWNORMAL)
End Sub

Talvez esteja fazendo algo errado.
abaixo tem bd de test do modelo que me sugeriu.
Veja o que estou fazendo de errado. Por favor com seu código.
Obrigado

cam7 e CaixaCombinação720 são dois campos que tenho no formulário

No cam7 é onde coloco o numero de oficio tipo 123/15 e CaixaCombinação720 éonde coloco a terminação tipo SI ficando 123/15/SI e ao criar o pdf guarda com o nome 123_15_SI.

Para melhor compreenderes procura no forum a função Replace, ou nos exemplos que postei no forum que encontras um com o oficio.