Email individual pdf files in outlook

[sonjuraec]

Okay- so here is my code. What i would like to do is replace the DoCmd.OutputTo line with a DoCmd.SentTo line to email the reports to the appropriate faculty instead of just saving them in the folder.

I used this line but it did not work: DoCmd.SendObject (acSendReport, , acFormatPDF, "vtblfaculty.email&'@xxx.edu'","me@xxx.edu",,"test","this is a test",-1,,)

I have been working on this forever!

Public Sub something3()
Dim db As Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT DISTINCT tblsection.Faculty, left(vtblfaculty.firstname,1)&vtblfaculty.lastname AS fn, vtblfaculty.email FROM vtblfaculty INNER JOIN tblsection ON tblsection.faculty=vtblfaculty.faculty WHERE term=" & Forms!frmimport!cbxTerm)

With rs
While Not rs.EOF
DoCmd.OpenReport "Backgrounds", acViewPreview, , "Faculty = '" & rs!Faculty & "'"
DoCmd.OutputTo acOutputReport, "Backgrounds", acFormatPDF, "C:\Users\Sonjurae\Desktop\" & rs!fn
DoCmd.Close
rs.MoveNext
Wend
End With
End Sub

 

[pbaldy]

Use SendObject, but specify the report. You might need to specify the report in the Close too.

 

[sonjuraec]

I am now here

Public Sub something5()
Dim db As Database
Dim rs As DAO.Recordset
Dim mailto As String
Dim ccto As String
Dim bccto As String
mailto = "xxx@xxx.edu"
ccto = ""
bccto = ""
emailmsg = "Hello," & vbNewLine & "Please review the attached report and contact me directly with any questions and/or concerns."
mailsub = "Student Backgrounds"
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT DISTINCT tblsection.Faculty, left(vtblfaculty.firstname,1)&vtblfaculty.lastname AS fn, vtblfaculty.email FROM vtblfaculty INNER JOIN tblsection ON tblsection.faculty=vtblfaculty.faculty WHERE tblsection.term=" & Forms!frmimport!cbxTerm)

With rs
While Not rs.EOF
DoCmd.OpenReport "Backgrounds", acViewPreview, , "Faculty = '" & rs!Faculty & "'"
DoCmd.OutputTo acOutputReport, "Backgrounds", acFormatPDF, "C:\Users\smcross\Desktop\test\" & rs!fn
DoCmd.SendObject acSendReport, "backgrounds", acFormatPDF, mailto, ccto, bccto, mailsub, emailmsg, False
DoCmd.Close
rs.MoveNext
Wend
End With
End Sub

Okay- I can get it to do what I want with this, but I don't know how to get the reports to send to the instructor's emails from my recordset. Another problem is that in the recordset, the email that is part of the recordset does not include the "@xxx.edu" stuff.

 

[pbaldy]

Well, you'd get the email from the recordset with:

rs!email

if the last part is consistent:

rs!email & "@xxx.edu"

 

[sonjuraec]

when i do that it keeps telling me expected end of line

 

[pbaldy]

On what line? And why have the With block if you don't use it?

 

[GaryPanic]

Hey see if this helps

i ruin a statement process - this creates the statement - and sends the statement automatically (statement stored on server)
and ".To = rsEmail.Fields(3)" is where my email address is
- works a charm (a little clunky on a larger run and i have built in a small pause -
* big note -I have pinched bits from all over the place on this - so 99% other peoples work and 1% (if that - mine )- so thanks to everyone i've pinched from G


Private Sub Command14_Click()
'On Error GoTo Err_Command14_Click


Dim MyDb As DAO.Database
Dim rsEmail As DAO.Recordset

Dim OutApp As Object
Dim OutMail As Object
Dim strAttach1 As String

Dim Attachment As String
Dim AccountNo As String

Dim attachments As String

Dim FilenameZ As String
Set MyDb = CurrentDb()
Set rsEmail = MyDb.OpenRecordset("statementemailQry", dbOpenSnapshot)
Dim FilterZ As String
Dim strID As String
Dim i As Integer
Dim emailstring As String


Signature = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(Signature, vbDirectory) <> vbNullString Then
Signature = Signature & Dir$(Signature & "*.htm")
Else:
Signature = ""
End If
Signature = CreateObject("Scripting.FileSystemObject").GetFile(Signature).OpenAsTextStream(1, -2).ReadAll




For i = 0 To rsEmail.RecordCount


rsEmail.MoveNext
Next i


With rsEmail

.MoveLast
.MoveFirst


Do Until rsEmail.EOF

If rsEmail.Fields(7) = "Broker" Then

DoCmd.OpenReport "Statementrptemail", acViewPreview, , "AccountNo = " & rsEmail.Fields(0) & "" '"


DoCmd.OutputTo acOutputReport, , acFormatPDF, "S:\zzzzz\yyyyyINTERNATIONAL\Statements\" & .Fields(6) & ".pdf", False
DoCmd.Close acReport, "Statementrptemail", acSaveYes

Else

'If rsEmail.Fields(7) = "Client" Then
DoCmd.OpenReport "StatementrptemailClient", acViewPreview, , "AccountNo = " & rsEmail.Fields(0) & "" '"

DoCmd.OutputTo acOutputReport, , acFormatPDF, "S:\zzzzz\yyyyyINTERNATIONAL\Statements\" & .Fields(6) & ".pdf", False
DoCmd.Close acReport, "StatementrptemailClient", acSaveYes

End If



strAttach1 = "S:\zzzzz\yyyyy INTERNATIONAL\Statements\" & .Fields(6) & ".pdf"


If IsNull(.Fields(3)) = False Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail

.To = rsEmail.Fields(3)

.Subject = "" & rsEmail.Fields(6)


.attachments.Add strAttach1

'.HTMLBody = emailstring & "<html><body><font face=calibri> Hello, <BR> testy</font></body></html>"

.HTMLBody = rsEmail.Fields(4) & "<BR>" & _
"Please find attached your current statement of account as at today's date" & "<BR>" _
& "If we can clear these items, in accordance with the payment terms, this would be greatly appreciated " & "<BR>" _
& "This is an automated statement run." & "<BR>" _
& "<BR>" & "Kind regards" & "<BR>"

'.Display
.Send

TWait = Time
TWait = DateAdd("s", 1, TWait)

Do Until TNow >= TWait
TNow = Time
Loop

End With
End If
.MoveNext

Loop

End With




Set MyDb = Nothing
Set rsEmail = Nothing

Exit_Command14_Click:
Exit Sub

Err_Command14_Click:
MsgBox Err.Description
Resume Exit_Command14_Click