Jumat, 27 Juni 2014

Re: [MS_AccessPros] 2 hour deadline to fix code to email contacts.

 

Steve,

I did not know any other way to do it. How would I check for the nulls?
 
Jim Wagner



On Friday, June 27, 2014 3:15 PM, "Steve Conklin StephenMConklin@hotmail.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:


 
Jim:
You are not doing any MOVENEXT on the RS_3. However, why are you using 2 recordsets?
Just use RS_1 and check for Nulls to skip the CC if not exists.
 
Steve Conklin
 

To: MS_Access_Professionals@yahoogroups.com
From: MS_Access_Professionals@yahoogroups.com
Date: Fri, 27 Jun 2014 15:04:43 -0700
Subject: [MS_AccessPros] 2 hour deadline to fix code to email contacts.

 
I have some code that I inherited and I am down to 2 hours before I go on vacation and my bosses are running the process on Tuesday. The code works without any crashes. The issue is that I had it working with no problems until I needed to add the .CC to the code. So I followed the code to add the .cc based on the rest of the code that references the .To line of code. My code is below. What is happening that it goes through all the 147 records and puts the emails out into the outbox in outlook but the issue is that I am getting the same person for the .cc instead of looping through and putting the correct Proxy name which is actually the email address. Here is the code. 

Any help would help. 
Thank you in advance

Jim Wagner


Private Sub cmd_VehicleSurveyEmail_Click()
' This routine is called to send out the Vehicle Survey link to ALL contact names
' Therefore, no criteria is used

'disable button so the user is unable to click it more than once
cmd_VehicleSurveyEmail.Enabled = False

  Dim dblTimer As Double

Set db = CurrentDb

Dim objol As Outlook.Application
Dim objmail As Outlook.MailItem

Set objol = New Outlook.Application
Set objmail = objol.CreateItem(olMailItem)


' Select the distince email addresses from the VehicleRequestData
' As mentioned before, since there is no criteria involved, we just need the email addresses of all the contact persons
strSQL = "SELECT DISTINCT [Contact Email], [Proxy Name] FROM VehicleRequestData"
strSQL1 = "SELECT DISTINCT [Contact Email],[Proxy Name] From VehicleRequestData WHERE (((VehicleRequestData.[Proxy Name]) Is Not Null));"

Set RS_1 = db.OpenRecordset(strSQL, dbOpenDynaset)


RS_1.MoveFirst

' The email body is stored in the tblVehicleSurveyEmailBody table, to make it edittable by the user
' We select the email body also
strSQL = "SELECT * FROM tblVehicleSurveyEmailBody"




' We now open all records from tblVehicleSurveyEmailBody
Set RS_2 = db.OpenRecordset(strSQL, dbOpenDynaset)
Set RS_3 = db.OpenRecordset(strSQL1, dbOpenDynaset)

RS_2.MoveFirst

emailbody = RS_2![Vehicle Survey Email Body]
' The hyperlink on the email body can only be inserted by using the <Href> tag.  This tag needs to be "anded" (&) - see below.
' Therefore, we always insert this link at the end of the email body.  See the usage below, it then becomes clear why
' The hyperlink and its title are also editable to the user, therefore, we extract it from the same table tblVehicleSurveyEmailBody
Hyperlink = RS_2![Hyperlink]
HyperlinkTitle = RS_2![Title of the Hyperlink]


Dim EmailAddress As String
Dim ProxyEmailAddress As String

Do While Not RS_1.EOF


    ' If a valid email address exist,
    If RS_1![Contact Email] <> "" Then
    
    ' Extract the email address
    EmailAddress = RS_1![Contact Email]
    ProxyEmailAddress = RS_3![Proxy Name]
    
    
    ' Create the Outlook mail object
    Set objmail = objol.CreateItem(olMailItem)
    With objmail
    
        ' The below line enables sending the email through the fleet services email id instead of the personal email id
        objmail.SentOnBehalfOfName = "Fleet-Services@exchange.asu.edu"
        .To = EmailAddress
        .CC = ProxyEmailAddress
        
        ' Set the subject
        .Subject = "IMPORTANT REMINDER - ASU VEHICLE INFORMATION DUE BY 7/31/14"
    
        ' Get the hyperlink and its title and append it to the email body, as shown below
        strLink = Hyperlink
        strHTML = "<HTML><Body>" & emailbody & "<p><a Href=" & strLink & " target=new>" & HyperlinkTitle & "</a></body></html>"
        
        '.Body sets the email format to plain text, .HTMLBody changes it to HTML format
        .HTMLBody = strHTML
        .NoAging = True

        .Display
    End With
    
    ' Send out the email
    SendKeys "%{s}", True
End If

    ' Move to the next contact person on the list
    'RS_1.MoveNext

' The below code snippet generates a time delay of 2 seconds between every 10 records.
' This is required because, more than 100 emails need to be sent out as part of this process
' and an intentional pause has to be introduced so that the system is not overwhelmed by the number of emails.
' The first part checks for every 10th record, and the second part sets up the timer.

' AbsolutePosition is the record number in a datasheet view.
' The Mod function is testing the divisibility of the AbsolutePosition for 10.
' Therefore, if the position value is divisible by 10 (example, 10, 20, 30, 40 ...), the rest of the loop is executed.
If RS_1.AbsolutePosition Mod 10 = 0 Then
    ' The dblTimer is initialized with the Timer value which is the current time.  The Timer value is incremented by the OS (DoEvents).
    dblTimer = Timer
    ' When the difference between current time and the time we started the loop becomes more than 2 seconds, the timer loop is stopped.
    Do Until (Timer - dblTimer) > 15
        DoEvents
    Loop
End If

RS_1.MoveNext
Loop


Set objmail = Nothing
Set objol = Nothing

' Inform the user that the process is complete
MsgBox "                    All Emails have been sent to the users Outbox      " & vbCrLf & " " & vbCrLf & "Do not forget to review emails before working online and sending reports"
End Sub
 
Jim Wagner



__._,_.___

Posted by: Jim Wagner <luvmymelody@yahoo.com>
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (3)

.

__,_._,___

Tidak ada komentar:

Posting Komentar