INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

VBA Code will not change name of PDF Attachment

VBA Code will not change name of PDF Attachment

(OP)
I am trying to automate a report distribution process using Access and Outlook 2007 and VBA. I have created a form for the user to enter a range of dates. I also have Query which points to the form as criteria. I would like to open the form, choose a range of dates and have the form open a report which will calculate scores per clinic, print the report to PDF, ADDING THE NAME OF THE CLINIC AS THE ATTACHMENT NAME  then attach the report to an Outlook email. I am also trying to Loop the code through all clinics listed on the source tables.
My issue is that I cannot get the VBA code to set attachment name based on the clinic_name from the Recordsource MailList. My current code does not change the Attachment Name to the clinic_name from my query..... Please Help......
This is the complete code that I have so far:

<CODE>

Option Compare Database
Option Explicit

Public Function SendEMail()

Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String
Dim MyNewBodyText As String


'============================================================================================================================
Set fso = New FileSystemObject

 ' Populate Subject Line
 
 Subjectline$ = InputBox$("Please enter the subject line for this mailing.", _
                 "Mystery Caller Survey Email All Reports!")

 ' If there's no subject, end Process.

If Subjectline$ = "" Then
    MsgBox "No subject line, no message." & vbNewLine & vbNewLine & _
        "Quitting...", vbCritical, "E-Mail Merger"
    Exit Function
End If
    
 ' Populate Body Text
 BodyFile$ = "F:\My UCLA Items\Mystery Caller\MystCallEmailScript.txt"

 ' If there's nothing to say, end process.

If BodyFile$ = "" Then
    MsgBox "No body, no message." & vbNewLine & vbNewLine & _
         "Quitting...", vbCritical, "No Message!"
    Exit Function
End If

 ' Check to make sure the file exists...
If fso.FileExists(BodyFile$) = False Then
    MsgBox "The body file isn't where you say it is. " & vbNewLine & vbNewLine & _
           "Quitting...", vbCritical, "No message!"
    Exit Function
End If

   ' Since we got a file, we can open it up.
    Set MyBody = fso.OpenTextFile(BodyFile, ForReading, False, TristateUseDefault)

   ' and read it into a variable.
    MyBodyText = MyBody.ReadAll

   ' and close the file.
    MyBody.Close

' Now, open Outlook for our own device..
    Set MyOutlook = New Outlook.Application
      
'===========================================================================================================================
   ' Set up the database and query connections
  
    Set db = CurrentDb()
     
     
   Set MailList = db.OpenRecordset("Contacts1")
          
' Loop through the list of email addresses FROM Contacts1,
' adding them to e-mails and sending them.

    Do Until MailList.EOF

' This creates the e-mail
 
       Set MyMail = MyOutlook.CreateItem(olMailItem)
            
' This addresses it
    MyMail.To = MailList("email")
                        
'This gives it a subject
     MyMail.Subject = Subjectline$
            
'This gives it the body
        MyMail.Body = "Dear" & MailList("Contact_First") & "," & MyBodyText
        
 'This line will copy the "master" template into
 'a variable we can mess around with
 
 MyNewBodyText = MyBodyText
 
 MyNewBodyText = Replace(MyNewBodyText, "[[Contact_First]]", MailList("Contact_First"))
 
 
'===========================================================================================================================
'Set Attachment Name

Dim AttachmentName As String
Dim NewAttachmentName As String
 
AttachmentName = MailList("Clinic_Name") & ".pdf"

NewAttachmentName = AttachmentName
NewAttachmentName = Replace(NewAttachmentName, "[[Clinic_Name]]", MailList("Clinic_Name"))

   '  Setup Attachment Print to PDF
   DoCmd.OutputTo acOutputReport, "rptCallResultsPerClinic1", "PDFFormat(*.PDF)", "F:\temp\AttachmentName.pdf", True, "", , acExportQualityScreen
 
  
   'This sends it!
   
    MyMail.Attachments.Add "F:\temp\AttachmentName.pdf", olByValue, 1, AttachmentName & ".pdf"
     
   MyMail.Save
     
    'And on to the next one...
    MailList.MoveNext

Loop
 
Set MyMail = Nothing

'MyOutlook.Quit
Set MyOutlook = Nothing

MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing
End Function
<CODE>
 

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close