[Resolvido]Relatório email

Bom dia,

Estou com um pequeno problema, Tenho um código que envia email sem anexo, e eu gostaria de poder introduzir em anexo o relatorio em PDF.
Vou postar os 2 códigos que tenho para saber se dava para juntar estes 2 codigos e formar um só:
1º - Serve para modificar o nome do relatório ao passar para PDF
2º - Serve para enviar email.

1º

DoCmd.OpenReport Form_Dif_filtro.Text4.Value, acViewDesign, , , acHidden
Reports(Form_Dif_filtro.Text4).Caption = Form_sub_report_metros.Text339.Value
DoCmd.Close acReport, Form_Dif_filtro.Text4.Value, acSaveYes

2º

Dim appOutlook As Object
Dim olMail As Object

'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 = Text207
.CC = "" & Me.Text209
.Subject = Me.Nome_Cliente_Final
'.Attachments.Add (CurrentProject.Path & "\" & "teste.xlsx")
.Body = Me.Text237 + vbNewLine + vbNewLine + Me.Text234.Value + vbNewLine + "OK para expedir." + vbNewLine + "Obrigado." + vbNewLine + vbNewLine + vbNewLine + "Roberto" + vbNewLine + "Área Medição"
.Send
End With
MsgBox "Email enviado com sucesso." & vbCrLf & "Para: " & Me.Text207.Value & vbCrLf & "Cc: " & Me.Text209.Value, vbInformation, "Email"

End Sub

Agradeço Ajuda...

Roberto

Uso esta função e envio até 3 Anexos (a vermelho), pelo mail do Sapo

Sub EnviarEmail()
On Error GoTo erromail
Dim Mens As CDO.Message
Dim Config As CDO.Configuration
Set Config = New CDO.Configuration
With Config
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Me.SMTP 'aqui foi configurado para uma conta de email do sapo, que é grátis
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Me.Porta ' porta usada pelo sapo
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = Me.Email 'se o email a ser usado para envio for fulano@pt, coloque fulano aqui
.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Me.Pass 'coloque a senha do seu email
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

.Fields.Update
End With

Set Mens = New CDO.Message
With Mens
Set .Configuration = Config
.From = Forms!Menu!Mail 'envia
If Not IsNull(Me.txtDeMail) Then
.Sender = Me.Email 'email de quem envia.
End If
If Not IsNull(Me.txtCOculta) Then
.BCC = Me.txtCOculta
End If
.Subject = Me.txtAssunto 'caixa texto assunto
.TextBody = Me.txtMensagem 'Caixa texto com o texto
.To = Me.txtPara 'caixa texto para quem vai o email"
If Not IsNull(Me.txtAnexo) Then
.AddAttachment (Me.txtAnexo)
End If
If Not IsNull(Me.txtAnexo1) Then
.AddAttachment (Me.txtAnexo1)
End If
If Not IsNull(Me.txtAnexo2) Then
.AddAttachment (Me.txtAnexo2)
End If

DoCmd.openForm "frmProgresso"
.Send ' envia

End With
MsgBox "@Mail Enviado com Sucesso", vbExclamation, "Gestão de @Mails"
DoCmd.Close acForm, "frmProgresso"
DoCmd.Close acForm, "email"
Set Mens = Nothing
Set Config = Nothing

Exit Sub
erromail:
If IsNull(Me!txtPara) Or Me!txtPara = "" Then
MsgBox "Falta o Mail do Destinatário", vbExclamation, "Gestão de @Mails"
Me.txtPara.SetFocus
Me.txtPara.Dropdown
Exit Sub
End If

'MsgBox err.Number & " " & err.Description
Set Mens = Nothing
Set Config = Nothing

Exit Sub

End Sub

Boa tarde Assis,

Eu envio o email através do Outlook que temos instalado nos PC da empresa.
Só queria mesmo poder anexar um report convertido em PDF ao código que eu postei.

Obrigado

Roberto
Tem de criar um campo na tabela texto, para guardar o caminho do documento (PDF) .... exemplo "Anexo"

Criar um campo no formulario de enviar email. Exemplo txtAnexo

acrescentar este código

If Not IsNull(Me.txtAnexo) Then
.AddAttachment (Me.txtAnexo)
End If


http://maximoaccess.forumeiros.com/t20420-resolvidoenviar-email-com-2-ou-mais-anexos-transformados-de-varios-relatorios-destintos#150374

Boa tarde,

Com o código que o Assis postou, ficou a funfar 5 *****.
Só tive que ajustar um pouco o meu código.
A BD agora guarda relatório numa pasta se ela existir ou então cria uma nova e anexa o relatório que quero ao email.

Vou postar como ficou o meu código....pode estar um pouco confuso por eu não atribuir os nomes as caixas de texto, mas eu me entendo.

Private Sub Command51_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 = "" & Form_sub_report_metros.Text339 & ".pdf"
strLocal = CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126 & "\" & Form_sub_report_metros.Text411 & "\" & strArquivo
If fso.folderexists(CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126 & "\" & Form_sub_report_metros.Text411) Then
DoCmd.OutputTo acOutputReport, Form_Dif_filtro.Text4.Value, acFormatPDF, strLocal
MsgBox "Arquivo criado com sucesso.", vbInformation, "Enviar para " & Form_sub_report_metros.Text126
End If
If Not fso.folderexists(CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126) Then
MkDir CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126
MkDir CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126 & "\" & Form_sub_report_metros.Text411
DoCmd.OutputTo acOutputReport, Form_Dif_filtro.Text4.Value, acFormatPDF, strLocal
MsgBox "Arquivo criado com sucesso.", vbInformation, "Enviar para " & Form_sub_report_metros.Text126
End If
If Not fso.folderexists(CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126 & "\" & Form_sub_report_metros.Text411) Then
MkDir CurrentProject.Path & "\PDF\" & Form_sub_report_metros.Text126 & "\" & Form_sub_report_metros.Text411
DoCmd.OutputTo acOutputReport, Form_Dif_filtro.Text4.Value, acFormatPDF, strLocal
MsgBox "Arquivo criado com sucesso.", vbInformation, "Enviar para " & Form_sub_report_metros.Text126
End If

'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 = "Meu_email@hotmail.com"
.CC = "Meu_email@hotmail.com"
.Subject = "Meu_email@hotmail.com"
If Not IsNull(strLocal) Then
.Attachments.Add (strLocal)
End If
'.Attachments.Add (CurrentProject.Path & "\" & "teste.xlsx")
.Body = "Meu_email@hotmail.com" + vbNewLine + vbNewLine + "Meu_email@hotmail.com" + vbNewLine + "OK para expedir." + vbNewLine + "Obrigado." + vbNewLine + vbNewLine + vbNewLine + "O seu nome" + vbNewLine + "Área"
.Send
End With
MsgBox "Email enviado com sucesso." & vbCrLf & "Para: " & "Meu_email@hotmail.com" & vbCrLf & "Cc: " & "Meu_email@hotmail.com", vbInformation, "Email"

End Sub


Obrigado

E agradeço também a ajuda ao Avelino.

Obrigado....

Obrigado pelo retorno

Como diz o GRANDE JPaulo
Há muitas maneiras de fazer nestum
Abraço