Save, rename and email report (1 Viewer)

[dsmith111]

Hello all,

I'm in Access 2007 and stuck.

I've been trying to do this with a macro, but I think I'll need some VBA to get all functionality. Unfortunately it’s been several years since I’ve written any code, and the knowledge seems to have left me. I’m hoping one of you has done this and will be able to provide the code.

My needed process has several steps.

1 - save PDF to specified file path
2 - save as file name derived from the query that feeds the report
3 – email the file to an address specified in the query that feeds the report.
3 – name emailed file and populate subject line from fields in the same query.

If anyone can help, I would greatly appreciate it!

Thanks,
Damian

 

[dsmith111]

BTW, if it maters, I will only be sending to one email address at a time.

 

[dsmith111]

I can't be the only person who's tried to do this, can I?

 

[Kiwiman]

Howzit

Hold your horses mate.

Try this - you will need to modify it to meet your needs

Private Sub Command21_Click()

Dim strRep As String
Dim strDPath As String
Dim strFName As String

' What report to send
strRep = "rptBookings"

' Initial Path
strDPath = CurrentProject.Path & "\"

' Filename
strFName = "Somefile.pdf"

' Output report as pdf
DoCmd.OutputTo acOutputReport, strRep, "PDFFormat(*.pdf)", strDPath & strFName, False, "", 0

' Send the report to whoever
Send_Email (strDPath & strFName)

End Sub

Private Sub Send_Email(strDoc As String)

Dim sTo As String
Dim sCC As String
Dim sBCC As String
Dim sSub As String
Dim sBody As String
Dim strCC As String
Dim OutApp As Object
Dim OutMail As Object
Dim varPress As Variant

' Original code copied from http://www.ozgrid.com/forum/showthread.php?t=51384

strMess = "You are about to send an email message to the current user." & vbCrLf & vbCrLf
strMess = strMess & "Do you wish to continue?"

strStyle = vbYesNo
strTitle = "Send Notificaiton"

varPress = MsgBox(strMess, strStyle, strTitle)
If varPress = vbYes Then
    ' Get the email address from the current form control
    sTo = "your email address from some field"
    
    '  Set the subject
    sSub = "Some subject matter"

    ' Build the body of the email
    sBody = "First name from some field" & vbCrLf & vbCrLf
    sBody = sBody & "Continue with message"
    
    ' Create the email
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    sCC = ""
    sBCC = ""
    
  
    With OutMail
        .To = sTo
        .CC = sCC
        .BCC = sBCC
        .Subject = sSub
        .Body = sBody
        .attachments.Add (strDoc)
        .Display          ' THis will display the email, but not send it
        '.Send            ' THis will send the email
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End If


End Sub

 

[dsmith111]

Thanks very much. I'll give it a try.

 

[dsmith111]

This looks like it does part of what I need, but I don't see where I can reference a query to find the email address, or how to reference the query to name the file. These are the parts that are really causing me problems.

thanks again.

 

[Kiwiman]

Howzit

You can use dlookups to get that info - there are only 3 of them so not that onerous. I assume your query only returns the one record? If not, what uniquely identifies the record in the query to allow the dlookup to get the correct data - we will need to add in criteria clauses in the dlookups.

You will need to replace the below in the relevant parts of the code

sTO = dlookup("[YourEmailField]","yourquery")

strFName = dlookup("[Filenamefield]","yourquery")

sSub  = dlookup("[yoursubjectfield]","yourquery")

 

[dsmith111]

Yes it only returns one record.

I'll try to get this to work and check back.

thanks!

 

[dsmith111]

Ok, looks like I need a little help.

When I try to run the code, using the RunCode action in a Macro, I get an error saying that it "cannot find the object 'rptRun_Notifications'". This is the exact name of my report, so I'm not sure what the problem is.

Here is the first part of the code that is causing the error.

Public Function Command21_Click()
Dim strRep As String
Dim strDPath As String
Dim strFName As String

' What report to send
strRep = "rptRun_Notifications"

' Initial Path
strDPath = CurrentProject.Path & "S:\Damian\Will Call 2012\Sent\"

' Filename
strFName = DLookup("[Dlr_Fax]", "99 - Dealer Email")

' Output report as pdf
DoCmd.OutputTo acOutputReport, strRep, "PDFFormat(*.pdf)", strDPath & strFName, False, "", 0

' Send the report to whoever
Send_Email (strDPath & strFName)

End Function

when I go to debug, the DoCmd line is higlighted.

 

[Kiwiman]

Howzit

This part is wrong. You want to remove the currentproject.path bit if you are going to specify a default loaction. What you are doing is adding the S Drive mapping to the existing location the database resides in. Not what you want

Change:

 'Initial Path
strDPath = CurrentProject.Path & "S:\Damian\Will Call 2012\Sent\"

To:

 Initial Path
strDPath = "S:\Damian\Will Call 2012\Sent\"

What line is actually showing the error? Ignore this I reread your post

 

[Kiwiman]

Howzit

Also, does the lookup return a valid value and does it have the fiel extension in the name?? If not you will need to add the extension on as part of the file name:

' Filename
strFName = DLookup("[Dlr_Fax]", "99 - Dealer Email")
' Add the file extension
strFName = strFName & ".pdf"

 

[dsmith111]

I made these changes, but am still getting the error on the DoCmd line. Still doesn't recognize the rpt. hmmm..

 

[Kiwiman]

Howzit

Is the name of the report correct?

 

[Kiwiman]

Howzit

Are you able to open and view the report using

DoCmd.OpenReport strRep, acViewPreview

 

[dsmith111]

Hey, it works! I had a typo in the report name.

Thank you SO much for your help. You've helped me to look very impressive in my project meeting next week!

I'll be sure to save this code and pass it on to someone else who may need it.

 

[Kiwiman]

Howzit

Nice one. Glad to help.

 

[dsmith111]

One more question. How would I make this DLookup statement pull multiple criteria and add a date to the naming convention?

' Filename
strFName = DLookup("[Dlr_Code]", "99 - Dealer Email")

For example, I want my name to be Dlr_Code + Order_Number + current date instead of just dlr code.

Thanks again!

 

[Kiwiman]

Howzit

I am away on business and have limited access at the moment. Depending on how onerous it is on performance you can use multiple lookups to build the name. Something like

 strFName = DLookup("[Dlr_Code]", "99 - Dealer Email")
 strFName = strFName & DLookup("[orderno]", "99 - Dealer Email")

Or alternatively if too slow use a dao recordset

Something like

Dim DB as dao.database
Dim rs as dao.recordset

Set DB = current.DB
Set rs = DB.openrecordset("yourquery")

If rs.eof and rs.bof
  'Nothing found
Else
  strFName = rs!yourfirstfield + rs!yoursecondfield etc
End if

Rs.close
Set rs = nothing
Set DB = nothing

 

[dsmith111]

First, thanks again for your help. The code works great. However I have run into an issue. I'm developing this DB for another department that has multiple email addresses in the same MS Outlook. I need to make sure that these emails are sent from a specific email address. Is there a way to specify the "from" email address?

Here's my code as it stands now.

Private Sub Send_Email(strDoc As String)
Dim sTo As String
Dim sCC As String
Dim sBCC As String
Dim sSub As String
Dim sBody As String
Dim strCC As String
Dim OutApp As Object
Dim OutMail As Object
Dim varPress As Variant
' Original code copied from http://www.ozgrid.com/forum/showthread.php?t=51384
strMess = "You are about to send an email message to ." & (DLookup("[Dlr_Fax]", "99 - Dealer Email")) & vbCrLf & vbCrLf
strMess = strMess & "Do you wish to continue?"
strStyle = vbYesNo
strTitle = "Send Notificaiton"
varPress = MsgBox(strMess, strStyle, strTitle)
If varPress = vbYes Then
' Get the email address from the current form control
sTo = DLookup("[Dlr_Fax]", "99 - Dealer Email")

' Set the subject
sSub = (DLookup("[Dlr_Code]", "99 - Dealer Email")) & "_Order_" & (DLookup("[MinOfOrder_Number]", "99 - Dealer Email")) & "_thru_" & (DLookup("[MaxOfOrder_Number]", "99 - Dealer Email"))
' Build the body of the email
' sBody = "First name from some field" & vbCrLf & vbCrLf
' sBody = sBody & "Continue with message"

' Create the email
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
sCC = ""
sBCC = ""


With OutMail
.To = sTo
.CC = sCC
.BCC = sBCC
.Subject = sSub
.Body = sBody
.attachments.Add (strDoc)
'.Display ' THis will display the email, but not send it
.Send ' THis will send the email
End With
Set OutMail = Nothing
Set OutApp = Nothing
End If

End Sub

 

[mtn]

This is in response to your last post. I think this should do it:

Private Sub Send_Email(strDoc As String, strEmailAccount As String)
Dim sTo As String
Dim sCC As String
Dim sBCC As String
Dim sSub As String
Dim sBody As String
Dim strCC As String
Dim OutApp As Object
Dim OutMail As Object
Dim OutAccount As Outlook.Account
Dim varPress As Variant
Dim varStatus As Boolean
' Original code copied from [URL]http://www.ozgrid.com/forum/showthread.php?t=51384[/URL]
strMess = "You are about to send an email message to ." & (DLookup("[Dlr_Fax]", "99 - Dealer Email")) & vbCrLf & vbCrLf
strMess = strMess & "Do you wish to continue?"
strStyle = vbYesNo
strTitle = "Send Notificaiton"
varPress = MsgBox(strMess, strStyle, strTitle)
If varPress = vbYes Then
    ' Get the email address from the current form control
    sTo = DLookup("[Dlr_Fax]", "99 - Dealer Email")
    
    ' Set the subject
    sSub = (DLookup("[Dlr_Code]", "99 - Dealer Email")) & "_Order_" & (DLookup("[MinOfOrder_Number]", "99 - Dealer Email")) & "_thru_" & (DLookup("[MaxOfOrder_Number]", "99 - Dealer Email"))
    ' Build the body of the email
    ' sBody = "First name from some field" & vbCrLf & vbCrLf
    ' sBody = sBody & "Continue with message"
    
    ' Create the email
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    sCC = ""
    sBCC = ""
    
    'Determine the correct account
    For Each OutAccount In OutApp.Session.Accounts
        If OutAccount = strEmailAccount Then
            varStatus = True
            With OutMail
            
                .To = sTo
                .CC = sCC
                .BCC = sBCC
                .Subject = sSub
                .Body = sBody
                .Attachments.Add (strDoc)
                '.Display ' THis will display the email, but not send it
                .Send ' THis will send the email
                
            End With
        Else
            varStatus = False
        End If
    Next
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    If varStatus = False Then
        MsgBox "Email request was cancelled because the account: " & strEmailAccount & " was not found."
    End If
End If
End Sub

Then send your email by calling the function this way - filepath and the email account name:

Send_Email "C:\Documents\Doc.pdf", "username@yourdomain.com"