billy_t
01-30-2013, 02:48 PM
Hello, I have the following code:
Sub Command_Button_0_Click()
'create emails for the New Consultant Region Scorecards
Dim db As DAO.Database
Dim fso As FileSystemObject
Dim lng_Cslt_Num As Long
Dim RS As DAO.Recordset
Dim str_Email As String
Dim str_FileName As String
Dim str_Fullname As String
Dim str_LastName As String
Dim str_PathName As String
Dim dte_Date As Date
Dim lng_RO_Num As Long
Set db = OpenDatabase("F:\1-Analysis\7-Productivity Reporting\2-New Cslt Tracking\Performance Tracking.accdb")
Set RS = db.OpenRecordset("qry_015B_RD_Contacts")
str_PathName = "C:\PDF Files\"
RS.MoveFirst
Do While Not RS.EOF
str_FileName = RS![NCS_FileName]
str_Fullname = str_PathName & strFileName
' check for file
' if file is FOUND then pass the appropriate parameters to Prepare_NCS_Communication_Region to create and save the appropriate e-mail
' if file is NOT FOUND then proceed to the next row in the recordset without reaction
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(str_Fullname)) Then
lng_RO_Num = RS![NCS_RO]
str_Email = RS![NCS_EMail]
str_LastName = RS![NCS_Last_Name]
dte_Date = RS![NCS_Dte]
Call Prepare_NCS_Communication_Region(lng_RO_Num, str_Fullname, str_Email, dte_Date)
Beep
End If
RS.MoveNext
Loop
RS.Close
db.Close
Set db = Nothing
frm_Distribute_2.Hide
End Sub
Sub Prepare_NCS_Communication_Region(lng_RO_Num As Long, str_Fullname As String, strRecipient As String, dte_Date As Date)
Dim myOLApp As Application
Dim myItem As MailItem
Dim myRecipient As Recipient
Dim mySubject As Object
Dim myAttachments As Attachments
Dim str_Body As String
Dim str_Subject As String
str_Body = "Attached, please find the " & Format(dte_Date, "Mmmm dd, yyyy") & " New Consultant Scorecard Report for your region. " & _
"Please direct any questions to the Business Reporting (IG) Mailbox."
str_Subject = Format(dte_Date, "Mmm dd, yyyy") & " New Consultant Scorecard RO: " & Format(lng_RO_Num, "000")
Set myOLApp = CreateObject("Outlook.Application")
Set myItem = myOLApp.CreateItem(olMailItem)
Set myRecipient = myItem.Recipients.Add(strRecipient)
Set myAttachments = myItem.Attachments
myItem.SentOnBehalfOfName = "Business Reporting (IG)"
myItem.Subject = str_Subject
myItem.Body = str_Body
myAttachments.Add str_Fullname, olByValue, 1
myItem.Save
Beep
End Sub
Now I know the Prepare_NCS_Communication_Region sub-procedure works as I tried pasting it to an independent module and declaring its parameters in the Dim section. I believe the button-click procedure works as well (could be wrong), I am thinking the issue is with the one line of code calling the other procedure:
Call Prepare_NCS_Communication_Region(lng_RO_Num, str_Fullname, str_Email, dte_Date)
When I press the button though, it does nothing and closes the form. It's supposed to create e-mail messages in my drafts folder for each record in my database query.
Can anyone advise please? Thank you!
Sub Command_Button_0_Click()
'create emails for the New Consultant Region Scorecards
Dim db As DAO.Database
Dim fso As FileSystemObject
Dim lng_Cslt_Num As Long
Dim RS As DAO.Recordset
Dim str_Email As String
Dim str_FileName As String
Dim str_Fullname As String
Dim str_LastName As String
Dim str_PathName As String
Dim dte_Date As Date
Dim lng_RO_Num As Long
Set db = OpenDatabase("F:\1-Analysis\7-Productivity Reporting\2-New Cslt Tracking\Performance Tracking.accdb")
Set RS = db.OpenRecordset("qry_015B_RD_Contacts")
str_PathName = "C:\PDF Files\"
RS.MoveFirst
Do While Not RS.EOF
str_FileName = RS![NCS_FileName]
str_Fullname = str_PathName & strFileName
' check for file
' if file is FOUND then pass the appropriate parameters to Prepare_NCS_Communication_Region to create and save the appropriate e-mail
' if file is NOT FOUND then proceed to the next row in the recordset without reaction
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(str_Fullname)) Then
lng_RO_Num = RS![NCS_RO]
str_Email = RS![NCS_EMail]
str_LastName = RS![NCS_Last_Name]
dte_Date = RS![NCS_Dte]
Call Prepare_NCS_Communication_Region(lng_RO_Num, str_Fullname, str_Email, dte_Date)
Beep
End If
RS.MoveNext
Loop
RS.Close
db.Close
Set db = Nothing
frm_Distribute_2.Hide
End Sub
Sub Prepare_NCS_Communication_Region(lng_RO_Num As Long, str_Fullname As String, strRecipient As String, dte_Date As Date)
Dim myOLApp As Application
Dim myItem As MailItem
Dim myRecipient As Recipient
Dim mySubject As Object
Dim myAttachments As Attachments
Dim str_Body As String
Dim str_Subject As String
str_Body = "Attached, please find the " & Format(dte_Date, "Mmmm dd, yyyy") & " New Consultant Scorecard Report for your region. " & _
"Please direct any questions to the Business Reporting (IG) Mailbox."
str_Subject = Format(dte_Date, "Mmm dd, yyyy") & " New Consultant Scorecard RO: " & Format(lng_RO_Num, "000")
Set myOLApp = CreateObject("Outlook.Application")
Set myItem = myOLApp.CreateItem(olMailItem)
Set myRecipient = myItem.Recipients.Add(strRecipient)
Set myAttachments = myItem.Attachments
myItem.SentOnBehalfOfName = "Business Reporting (IG)"
myItem.Subject = str_Subject
myItem.Body = str_Body
myAttachments.Add str_Fullname, olByValue, 1
myItem.Save
Beep
End Sub
Now I know the Prepare_NCS_Communication_Region sub-procedure works as I tried pasting it to an independent module and declaring its parameters in the Dim section. I believe the button-click procedure works as well (could be wrong), I am thinking the issue is with the one line of code calling the other procedure:
Call Prepare_NCS_Communication_Region(lng_RO_Num, str_Fullname, str_Email, dte_Date)
When I press the button though, it does nothing and closes the form. It's supposed to create e-mail messages in my drafts folder for each record in my database query.
Can anyone advise please? Thank you!