Vba between Filter (1 Viewer)

[giddyhead]

When I use the .Send in Outlook 2010 I get a runtime error 287. And the Do Events code is my trying to alternate method to send emails automatically. When I use the Msgbox function to confirm if all the findwindows were closed and it turns out that it stills finds another window even if all the windows were closed. That is where I am having my concern.

In addition if there was a way to use the between strings for example 2017-01 - 2017-04 which has lets say 4 records. How can I add the between fields data from the VBA SQL in the body of the email? For example 2017-01, 2017-02, 2017-03, 2017-04. Thanks

 

[Minty]

You have at least two issues here.

1. The construction of the email body.
2. Sending the email.

Sort out No. 1 first, once that is in an acceptable format problem 2 may disappear.

To solve No.1 please can you show us what you are trying to actually format as the message body. No database jargon, just the text followed by where that information is held, either in a table or from unbound text boxes on a form.

 

[giddyhead]

Minty,

I solve the first concern I put the dates for the form in the body of the email which covers dates. for example you have checked out 2 items between 2017-01 and 2017-06 . Items check out are 1 scale & 1 Microphone.

Request you assistance as currently the issue with sending emails are with outlook 2010 is there an API function that will work with all outlooks? Thanks.

 

[Minty]

I think you have missed my point, you need to construct the email body as a string variable Outside of the email body routine. Muddling the two together is probably causing your email sending problems.

In Pseudo code you need to do the following;

Gather all the information for your email body.
Format it into a single string variable - call it strBody
Debug.Print strBody and examine the output in the immediate window. If it is correct
Then use that as your .Body = strBody

You still haven't posted up your outlook email sending code, so we can see what is wrong with that.

 

[giddyhead]

Minty,

The following is my sending code when use .send it works on 2016, however when I used on 2010 a runtime error 287 occur. I will work on the code and post it shortly. Thanks.

'On Error GoTo SubErrorR

Dim Outlook As Outlook.Application
Dim Emails As mailitem
Dim oOutlook As Outlook.Application
'Dim rst As DAO.Recordset
Dim rstc As DAO.Recordset

Dim mailitems As Outlook.mailitem
Dim MailsiTem As Outlook.mailitem
Dim Rsgc As Recordset
'Dim rsg, rsga As Recordset
Dim Email As String
Dim T_Email As String
IniOutlook
'Set mailitemza = outlookapp.CreateItem(olMailItem)
Set MailsiTem = outlookapp.CreateItem(olMailItem)
'Dim db As DAO.Database
Dim strSQL, strSQL_Upper As String
'Dim rst As DAO.Recordset

Dim i, f As Integer
Dim emailcount As Integer
i = 0
f = 0

strSQL = "SELECT [Items Issued tbl].Department, Count([Items Issued tbl].Department) AS [# Per Department], Sum(IIf([reissued]=""Reporting"",""1"",""0"")) AS Reporting,Sum(IIf([reissued]=""7 Month"",""1"",""0"")) AS [7 Month], Sum(IIf([reissued]=""20 Month"",""1"",""0"")) AS [20 Month], Sum(IIf([reissued]=""02 Month"",""1"",""0"")) AS [02 Month], Sum(IIf([reissued]=""15 Month"",""1"",""0"")) AS [15 Month], Sum(IIf([reissued]=""13 Month"",""1"",""0"")) AS [13 Month], Sum(IIf([reissued]=""12 Month"",""1"",""0"")) AS [12 Month], Sum(IIf([reissued]=""8 Month"",""1"",""0"")) AS [8 Month], Sum(IIf([reissued]=""17 Month"",""1"",""0"")) AS [17 Month], [Email Address].[Email Address] " & vbCrLf & _
"FROM [Items Issued tbl] INNER JOIN [Email Address] ON [Items Issued tbl].Department = [Email Address].Department " & vbCrLf & _
"WHERE ((([Items Issued tbl].[Issued On]) Between '" & [Forms]![Issued Items Frm]![Begin-Date] & "' And '" & [Forms]![Issued Items Frm]![End-Date] & "')) " & vbCrLf & _
"GROUP BY [Items Issued tbl].Department, [Email Address].[Email Address];"

Debug.Print (strSQL)


Set Rsgc = CurrentDb.OpenRecordset(strSQL)

If (Rsgc.RecordCount) < 1 Then
MsgBox "No Records Found!" & Chr(13) & Chr(13) & Chr(45) & "Respectfully Team" & Chr(45), 64, "(Database)"

End If

Dim a As String
a = 0
'Set rsga = CurrentDb.OpenRecordset(strSQL)
Rsgc.MoveLast
SysCmd acSysCmdInitMeter, "Please wait working on request...", Rsgc.RecordCount
Rsgc.MoveFirst

Do Until Rsgc.EOF
a = a + 1
    SysCmd acSysCmdUpdateMeter, a
    
    'Keep the application responding (optional)
   DoEvents

    Rsgc.MoveNext

Loop
SysCmd acSysCmdRemoveMeter

If Rsgc.RecordCount > 0 Then

Rsgc.MoveFirst
Do Until Rsgc.EOF

If IsNull(Rsgc![Email Address]) Then

Rsgc.MoveNext

Else
If oOutlook Is Nothing Then
Set oOutlook = New Outlook.Application
End If
Set Emails = oOutlook.CreateItem(olMailItem)

With Emails

.To = Rsgc![Email Address]
.Subject = "Department " & Rsgc!Department & " Issue Status "
.Body = "You have recieved " & Rsgc![# Per Department]
 

             .ReadReceiptRequested = True
            .Importance = olImportanceHigh
                              
           .Display
 
   Dim rctrlrenwnd As Long
Dim afxwndw As Long
Dim X As Long
Dim Button As Long

           
' Do
'DoEvents
'rctrlrenwnd = FindWindow("rctrl_renwnd32", vbNullString)
'afxwndw = FindWindowEx(rctrlrenwnd, 0&, "afxwndw", vbNullString)
'afxwndw = FindWindowEx(afxwndw, 0&, "afxwndw", vbNullString)
'X = FindWindowEx(afxwndw, 0&, "#32770", vbNullString)
'Button = FindWindowEx(X, 0&, "button", vbNullString)
'Call SendMessageLong(Button, WM_LBUTTONDOWN, 0&, 0&)
'Call SendMessageLong(Button, WM_LBUTTONUP, 0&, 0&)
'Loop Until X < 0
 
            '.Send
   
        End With
    Set Emails = Nothing
Set oOutlook = Nothing

Rsgc.MoveNext

End If
Loop
SysCmd acSysCmdRemoveMeter
End If

SubExitT:

On Error Resume Next
 Set Emails = Nothing
Set oOutlook = Nothing

'Rsgc.Close
Set Rsgc = Nothing
Exit Sub

SubErrorR:
MsgBox "Error Message -> " & Err.Description & " <-" & " has occured", vbCritical, "An Error Occured"
'MsgBox "Error Number: " & "Err.Number" & " " & "Err.discription", vbCritical, "An Error occured"
GoTo SubExitT

 

[Minty]

Okay with out looking to hard, I suspect your problem is that you are using early binding, and that the references set in 2016 won't work on the 2010 version.

You need to use late-binding Instead of hardcoding the object at the beginning of your code using

Dim oOutlook As Outlook.Application

You should use

 Dim oOutlook  As Object

Then

 Set oOutlook  = CreateObject("Outlook.Application")

Read more about binding here https://support.microsoft.com/en-us/help/245115/using-early-binding-and-late-binding-in-automation

In addition I would create the variables for your mail objects Outside of the With .Mail eg.

Dim strEmailAdd as string
Dim strSubject as string
Dim strBody as string

strEmailAdd = Rsgc![Email Address]
strSubject  = "Department " & Rsgc!Department & " Issue Status "
strBody = "You have recieved " & Rsgc![# Per Department]


With Emails

    .To = strEmailAdd 
    .Subject = strSubject  
    .Body = strBody 
    .ReadReceiptRequested = True
    .Importance = olImportanceHigh
    .Display

Your use of the InitMeter is confusing, as you are going through your entire recordset moving the meter from 0 - 100 percent without actually doing any processing? You then move on to process the emails.

 

[giddyhead]

Thanks for the update I will work on the meter shortly. I have not use the send function on 2010 but will tomorrow. The following is my update code. What I want to do is to send an email to the POC Email Address of [UCC-Email_Address(H)-P] with a Total Number of Items for example 3 Reporting, etc and the list of names in the same group emails. Thanks.

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.mailitem
Dim strbody, strSQL, strSQL2 As String
Dim stremail As String
Dim strsubject As String

Set OutApp = CreateObject("Outlook.Application")
DoCmd.OpenForm "EMAIL_DATA"
Forms!EMAIL_DATA.Visible = False

Dim rs, rst As DAO.Recordset


strSQL = " SELECT [CDB LIST].LOCATION, Count([CDB LIST].LOCATION) AS [# of Personnel], Sum(IIf([Reason]=""Reporting"",""1"",""0"")) AS Reporting, Sum(IIf([Reason]=""24 Month"",""1"",""0"")) AS [24 Month], Sum(IIf(Left([reason],8)=""Biennial"",""1"",""0"")) AS Biennial, Sum(IIf([Reason]=""36 Month"",""1"",""0"")) AS [36 Month], Sum(IIf([Reason]=""48 Month"",""1"",""0"")) AS [48 Month], Sum(IIf([Reason]=""60 Month"",""1"",""0"")) AS [60 Month], Sum(IIf([Reason]=""72 Month"",""1"",""0"")) AS [72 Month], Unit_InformationS.[LEAD-Email_Address(H)], Unit_InformationS.[OIC-Email_Address(H)], Unit_InformationS.[SEL-Email_Address(H)-P], Unit_InformationS.[SEL-Email_Address(H)-A], Unit_InformationS.[UCC-Email_Address(H)-P], Unit_InformationS.[UCC-Email_Address(H)-A], Unit_InformationS.[UCC-Email_Address(H)-T], Unit_InformationS.[Admin-Email_Address(H)-P], Unit_InformationS.[Admin-Email_Address(H)-A], Unit_InformationS.[Medical-Email_Address(H)-P], " & _
"Unit_InformationS.[Medical-Email_Address(H)-A], Sum(IIf([Required Date]=""2016-12"",""1"",""0"")) AS [2016-12], Sum(IIf([Required Date]=""2017-01"",""1"",""0"")) AS [2017-01], Sum(IIf([Required Date]=""2017-02"",""1"",""0"")) AS [2017-02], Sum(IIf([Required Date]=""2017-03"",""1"",""0"")) AS [2017-03], Sum(IIf([Required Date]=""2017-04"",""1"",""0"")) AS [2017-04], Sum(IIf([Required Date]=""2017-05"",""1"",""0"")) AS [2017-05], Sum(IIf([Required Date]=""2017-06"",""1"",""0"")) AS [2017-06], Sum(IIf([Required Date]=""2017-07"",""1"",""0"")) AS [2017-07], Sum(IIf([Required Date]=""2017-08"",""1"",""0"")) AS [2017-08], Sum(IIf([Required Date]=""2017-09"",""1"",""0"")) AS [2017-09], Sum(IIf([Required Date]=""2017-10"",""1"",""0"")) AS [2017-10], Sum(IIf([Required Date]=""2017-11"",""1"",""0"")) AS [2017-11], Sum(IIf([Required Date]=""2017-12"",""1"",""0"")) AS [2017-12], Sum(IIf([Required Date]=""2018-01"",""1"",""0"")) AS [2018-01], Sum(IIf([Required Date]=""2018-02"",""1"",""0"")) AS [2018-02], " & _
"Sum(IIf([Required Date]=""2018-03"",""1"",""0"")) AS [2018-03], Sum(IIf([Required Date]=""2018-04"",""1"",""0"")) AS [2018-04], Sum(IIf([Required Date]=""2018-05"",""1"",""0"")) AS [2018-05], Sum(IIf([Required Date]=""2018-06"",""1"",""0"")) AS [2018-06], Sum(IIf([Required Date]=""2018-07"",""1"",""0"")) AS [2018-07], Sum(IIf([Required Date]=""2018-08"",""1"",""0"")) AS [2018-08], Sum(IIf([Required Date]=""2018-09"",""1"",""0"")) AS [2018-09], Sum(IIf([Required Date]=""2018-10"",""1"",""0"")) AS [2018-10], Sum(IIf([Required Date]=""2018-11"",""1"",""0"")) AS [2018-11], Sum(IIf([Required Date]=""2018-12"",""1"",""0"")) AS [2018-12] " & _
" FROM [CDB LIST] LEFT JOIN Unit_InformationS ON [CDB LIST].LOCATION = Unit_InformationS.[(R)LOCATION] " & _
" WHERE ((([CDB LIST].[Required Date]) Between '" & [Forms]![CDB_INDV]![Begin-Date] & "' And '" & [Forms]![CDB_INDV]![End-Date] & "') AND (([CDB LIST].Received) Is Null)) " & _
" GROUP BY [CDB LIST].LOCATION, Unit_InformationS.[LEAD-Email_Address(H)], Unit_InformationS.[OIC-Email_Address(H)], Unit_InformationS.[SEL-Email_Address(H)-P], Unit_InformationS.[SEL-Email_Address(H)-A], Unit_InformationS.[UCC-Email_Address(H)-P], Unit_InformationS.[UCC-Email_Address(H)-A], Unit_InformationS.[UCC-Email_Address(H)-T], Unit_InformationS.[Admin-Email_Address(H)-P], Unit_InformationS.[Admin-Email_Address(H)-A], Unit_InformationS.[Medical-Email_Address(H)-P], Unit_InformationS.[Medical-Email_Address(H)-A];"


strSQL2 = "SELECT [CDB LIST].LOCATION, [CDB LIST].[Title], [CDB LIST].Name, Count([CDB LIST].LOCATION) AS [# of Personnel], Sum(IIf([Reason]=""Reporting"",""1"",""0"")) AS Reporting, Sum(IIf([Reason]=""24 Month"",""1"",""0"")) AS [24 Month], Sum(IIf(Left([reason],8)=""Biennial"",""1"",""0"")) AS Biennial, Sum(IIf([Reason]=""36 Month"",""1"",""0"")) AS [36 Month], Sum(IIf([Reason]=""48 Month"",""1"",""0"")) AS [48 Month], Sum(IIf([Reason]=""60 Month"",""1"",""0"")) AS [60 Month], Sum(IIf([Reason]=""72 Month"",""1"",""0"")) AS [72 Month], Unit_InformationS.[LEAD-Email_Address(H)], Unit_InformationS.[OIC-Email_Address(H)], Unit_InformationS.[SEL-Email_Address(H)-P], Unit_InformationS.[SEL-Email_Address(H)-A], Unit_InformationS.[UCC-Email_Address(H)-P], Unit_InformationS.[UCC-Email_Address(H)-A], Unit_InformationS.[UCC-Email_Address(H)-T], Unit_InformationS.[Admin-Email_Address(H)-P], Unit_InformationS.[Admin-Email_Address(H)-A], " & _
"Unit_InformationS.[Medical-Email_Address(H)-P], Unit_InformationS.[Medical-Email_Address(H)-A], Sum(IIf([Required Date]=""2016-12"",""1"",""0"")) AS [2016-12], Sum(IIf([Required Date]=""2017-01"",""1"",""0"")) AS [2017-01], Sum(IIf([Required Date]=""2017-02"",""1"",""0"")) AS [2017-02], Sum(IIf([Required Date]=""2017-03"",""1"",""0"")) AS [2017-03], Sum(IIf([Required Date]=""2017-04"",""1"",""0"")) AS [2017-04], Sum(IIf([Required Date]=""2017-05"",""1"",""0"")) AS [2017-05], Sum(IIf([Required Date]=""2017-06"",""1"",""0"")) AS [2017-06], Sum(IIf([Required Date]=""2017-07"",""1"",""0"")) AS [2017-07], Sum(IIf([Required Date]=""2017-08"",""1"",""0"")) AS [2017-08], Sum(IIf([Required Date]=""2017-09"",""1"",""0"")) AS [2017-09], Sum(IIf([Required Date]=""2017-10"",""1"",""0"")) AS [2017-10], Sum(IIf([Required Date]=""2017-11"",""1"",""0"")) AS [2017-11], Sum(IIf([Required Date]=""2017-12"",""1"",""0"")) AS [2017-12], Sum(IIf([Required Date]=""2018-01"",""1"",""0"")) AS [2018-01], " & _
"Sum(IIf([Required Date]=""2018-02"",""1"",""0"")) AS [2018-02], Sum(IIf([Required Date]=""2018-03"",""1"",""0"")) AS [2018-03], Sum(IIf([Required Date]=""2018-04"",""1"",""0"")) AS [2018-04], Sum(IIf([Required Date]=""2018-05"",""1"",""0"")) AS [2018-05], Sum(IIf([Required Date]=""2018-06"",""1"",""0"")) AS [2018-06], Sum(IIf([Required Date]=""2018-07"",""1"",""0"")) AS [2018-07], Sum(IIf([Required Date]=""2018-08"",""1"",""0"")) AS [2018-08], Sum(IIf([Required Date]=""2018-09"",""1"",""0"")) AS [2018-09], Sum(IIf([Required Date]=""2018-10"",""1"",""0"")) AS [2018-10], Sum(IIf([Required Date]=""2018-11"",""1"",""0"")) AS [2018-11], Sum(IIf([Required Date]=""2018-12"",""1"",""0"")) AS [2018-12] " & vbCrLf & _
"FROM [CDB LIST] LEFT JOIN Unit_InformationS ON [CDB LIST].LOCATION = Unit_InformationS.[(R)LOCATION] " & vbCrLf & _
"WHERE ((([CDB LIST].[Required Date]) Between '" & [Forms]![CDB_INDV]![Begin-Date] & "' And '" & [Forms]![CDB_INDV]![End-Date] & "')  And (([CDB LIST].Received) Is Null)) " & vbCrLf & _
"GROUP BY [CDB LIST].LOCATION, [CDB LIST].[Title], [CDB LIST].Name, Unit_InformationS.[LEAD-Email_Address(H)], Unit_InformationS.[OIC-Email_Address(H)], Unit_InformationS.[SEL-Email_Address(H)-P], Unit_InformationS.[SEL-Email_Address(H)-A], Unit_InformationS.[UCC-Email_Address(H)-P], Unit_InformationS.[UCC-Email_Address(H)-A], Unit_InformationS.[UCC-Email_Address(H)-T], Unit_InformationS.[Admin-Email_Address(H)-P], Unit_InformationS.[Admin-Email_Address(H)-A], Unit_InformationS.[Medical-Email_Address(H)-P], Unit_InformationS.[Medical-Email_Address(H)-A];"

strSQL3 = "SELECT [CDB LIST].[Title], [CDB LIST].Name " & vbCrLf & _
"FROM [CDB LIST] LEFT JOIN Unit_InformationS ON [CDB LIST].LOCATION = Unit_InformationS.[(R)LOCATION] " & vbCrLf & _
"GROUP BY [CDB LIST].[Title], [CDB LIST].Name;"

Set rs = CurrentDb.OpenRecordset(strSQL) 
Set rs2 = CurrentDb.OpenRecordset(strSQL2)
Set rs3 = CurrentDb.OpenRecordset(strSQL3)

With rs

If .EOF And .BOF Then
MsgBox "No emails will be sent because there are no records assigned from the list", vbInformation
Else
Do Until .EOF




    stremail = ![UCC-Email_Address(H)-P] ''Query2 Fields [email];  [Address];  [Name]
    strsubject = "Item checked out " & !LOCATION
    strbody = "Sir/Ma'am," & vbCr & vbCr & "This email is to notify you that they are currently " & ![# of Personnel] & " Personnel that are due for CDBs between " & [Forms]![CDB_INDV]![Begin-Date] & " And " & [Forms]![CDB_INDV]![End-Date] & " ." & vbCr & _
"The Following are the break down in Numbers:" & vbCr & vbCr & "Reporting: " & !reporting & vbCr & "24 Months: " & ![24 Month] & vbCr & "Biennial: " & ![Biennial] & vbCr & "36 Month: " & ![36 Month] & vbCr & "48 Month: " & ![48 Month] & vbCr & "60 Month: " & ![60 Month] & vbCr & "72 Month: " & ![72 Month] & vbCr & vbCr & _
"The Following are the break down in Personnel pending:" & !Name & vbCr & _
"If any questions please let me know." & vbCr & vbCr & "Thank you in advance for your support in this matter." & vbCr & vbCr & Forms![EMAIL_DATA]![Email_Comments]




On Error Resume Next
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
    .To = stremail
    .CC = ""
    .BCC = ""
    .Subject = strsubject
    .Body = strbody

    .SendUsingAccount = OutApp.Session.Accounts.Item(2)
    .Display
    
        End With
            .MoveNext
Loop

'On Error GoTo 0

If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If

If Not rst Is Nothing Then
rst.Close
Set rst = Nothing
End If

Set OutMail = Nothing
Set OutApp = Nothing

End If
End With

 

[Minty]

Okay a couple of things still aren't correct

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.mailitem

You are still declaring these as outlook objects. Don't - use the late binding method;

Dim OutApp As Object
Dim OutMail As Object

You can't declare multiple items at one time, so

Dim rs, rst As DAO.Recordset

Will declare rs as a variant and only rst as a recordset. You also aren't declaring all the recordsets you are then using.
Same with

Dim strbody, strSQL, strSQL2 As String

Please add Option Explicit at the top of your module code, do it to all your procedures - it forces variable declaration and will highlight spelling errors.
I would recommend that you make this the default by going into the vba editor options and selecting Force Variable Declaration.

I'm also dubious that this line will work

    stremail = ![UCC-Email_Address(H)-P] ''Query2 Fields [email];  [Address];  [Name]

- it doesn't look well formatted to me or even clear what your are trying to pull in?

Edit: Also please please get rid of all those awful field names. Remove any spaces, and especially any special non standard characters like ( ) they cause you a heap of extra typing and brackets and make it look like your referencing an array or function half way through your query. Have a read up here http://www.access-programmers.co.uk/forums/showthread.php?t=225837 about naming conventions and field name restrictions.

 

[giddyhead]

Made the changes with the default Option Explicit, with the naming conventions and with declaring.

'

'You must add a reference to the Microsoft Outlook Library
Dim OutApp As Object
Dim OutMail As Object
'Dim OutApp As Outlook.Application


Dim strbody As String
Dim strSQL As String
Dim strSQL2 As String
'Dim strSQL3 As String
Dim stremail As String
Dim strsubject As String
Dim n As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)


DoCmd.OpenForm "EMAIL_DATA"
Forms!EMAIL_DATA.Visible = False
DoCmd.SetWarnings False
    
    Application.SetOption "Show Status Bar", True
    
    
 
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rs3 As DAO.Recordset

strSQL = "SELECT ItmsCheckOutbyMonthtbl.Office, Count(ItmsCheckOutbyMonthtbl.Office) AS [# of Personnel], Sum(IIf([Reason]=""Reporting"",""1"",""0"")) AS Reporting, Sum(IIf([Reason]=""24 Month"",""1"",""0"")) AS [24 Month], Sum(IIf([Reason]=Left([reason],8)=""Biennial"",""1"",""0"")) AS Biennial, Sum(IIf([Reason]=""36 Month"",""1"",""0"")) AS [36 Month], Sum(IIf([Reason]=""48 Month"",""1"",""0"")) AS [48 Month], Sum(IIf([Reason]=""60 Month"",""1"",""0"")) AS [60 Month], Sum(IIf([Reason]=""72 Month"",""1"",""0"")) AS [72 Month], OfficeInformation.LeadAddress, OfficeInformation.LeadEAddress, Sum(IIf([Required Date]=""2016-12"",""1"",""0"")) AS [2016-12], Sum(IIf([Required Date]=""2017-01"",""1"",""0"")) AS [2017-01], Sum(IIf([Required Date]=""2017-02"",""1"",""0"")) AS [2017-02], Sum(IIf([Required Date]=""2017-03"",""1"",""0"")) AS [2017-03], Sum(IIf([Required Date]=""2017-04"",""1"",""0"")) AS [2017-04], Sum(IIf([Required Date]=""2017-05"",""1"",""0"")) AS [2017-05], " & _
"Sum(IIf([Required Date]=""2017-06"",""1"",""0"")) AS [2017-06], Sum(IIf([Required Date]=""2017-07"",""1"",""0"")) AS [2017-07], Sum(IIf([Required Date]=""2017-08"",""1"",""0"")) AS [2017-08], Sum(IIf([Required Date]=""2017-09"",""1"",""0"")) AS [2017-09], Sum(IIf([Required Date]=""2017-10"",""1"",""0"")) AS [2017-10], Sum(IIf([Required Date]=""2017-11"",""1"",""0"")) AS [2017-11], Sum(IIf([Required Date]=""2017-12"",""1"",""0"")) AS [2017-12], Sum(IIf([Required Date]=""2018-01"",""1"",""0"")) AS [2018-01], Sum(IIf([Required Date]=""2018-02"",""1"",""0"")) AS [2018-02], Sum(IIf([Required Date]=""2018-03"",""1"",""0"")) AS [2018-03], Sum(IIf([Required Date]=""2018-04"",""1"",""0"")) AS [2018-04], Sum(IIf([Required Date]=""2018-05"",""1"",""0"")) AS [2018-05], Sum(IIf([Required Date]=""2018-06"",""1"",""0"")) AS [2018-06], Sum(IIf([Required Date]=""2018-07"",""1"",""0"")) AS [2018-07], Sum(IIf([Required Date]=""2018-08"",""1"",""0"")) AS [2018-08], " & _
"Sum(IIf([Required Date]=""2018-09"",""1"",""0"")) AS [2018-09], Sum(IIf([Required Date]=""2018-10"",""1"",""0"")) AS [2018-10], Sum(IIf([Required Date]=""2018-11"",""1"",""0"")) AS [2018-11], Sum(IIf([Required Date]=""2018-12"",""1"",""0"")) AS [2018-12] " & vbCrLf & _
"FROM ItmsCheckOutbyMonthtbl LEFT JOIN OfficeInformation ON ItmsCheckOutbyMonthtbl.Office = OfficeInformation.Office " & vbCrLf & _
"WHERE (((ItmsCheckOutbyMonthtbl.[Required Date]) Between '" & [Forms]![CDB_INDV]![Begin-Date] & "' And '" & [Forms]![CDB_INDV]![End-Date] & "')  AND ((ItmsCheckOutbyMonthtbl.Received) Is Null)) " & vbCrLf & _
"GROUP BY ItmsCheckOutbyMonthtbl.Office, OfficeInformation.LeadAddress, OfficeInformation.LeadEAddress;"


strSQL2 = "SELECT ItmsCheckOutbyMonthtbl.Office, ItmsCheckOutbyMonthtbl.Name, Count(ItmsCheckOutbyMonthtbl.Office) AS [# of Personnel], Sum(IIf([Reason]=""Reporting"",""1"",""0"")) AS Reporting, Sum(IIf([Reason]=""24 Month"",""1"",""0"")) AS [24 Month], Sum(IIf([Reason]=Left([reason],8)=""Biennial"",""1"",""0"")) AS Biennial, Sum(IIf([Reason]=""36 Month"",""1"",""0"")) AS [36 Month], Sum(IIf([Reason]=""48 Month"",""1"",""0"")) AS [48 Month], Sum(IIf([Reason]=""60 Month"",""1"",""0"")) AS [60 Month], Sum(IIf([Reason]=""72 Month"",""1"",""0"")) AS [72 Month], OfficeInformation.LeadAddress, OfficeInformation.LeadEAddress, Sum(IIf([Required Date]=""2016-12"",""1"",""0"")) AS [2016-12], Sum(IIf([Required Date]=""2017-01"",""1"",""0"")) AS [2017-01], Sum(IIf([Required Date]=""2017-02"",""1"",""0"")) AS [2017-02], Sum(IIf([Required Date]=""2017-03"",""1"",""0"")) AS [2017-03], Sum(IIf([Required Date]=""2017-04"",""1"",""0"")) AS [2017-04], Sum(IIf([Required Date]=""2017-05"",""1"",""0"")) AS [2017-05], " & _
"Sum(IIf([Required Date]=""2017-06"",""1"",""0"")) AS [2017-06], Sum(IIf([Required Date]=""2017-07"",""1"",""0"")) AS [2017-07], Sum(IIf([Required Date]=""2017-08"",""1"",""0"")) AS [2017-08], Sum(IIf([Required Date]=""2017-09"",""1"",""0"")) AS [2017-09], Sum(IIf([Required Date]=""2017-10"",""1"",""0"")) AS [2017-10], Sum(IIf([Required Date]=""2017-11"",""1"",""0"")) AS [2017-11], Sum(IIf([Required Date]=""2017-12"",""1"",""0"")) AS [2017-12], Sum(IIf([Required Date]=""2018-01"",""1"",""0"")) AS [2018-01], Sum(IIf([Required Date]=""2018-02"",""1"",""0"")) AS [2018-02], Sum(IIf([Required Date]=""2018-03"",""1"",""0"")) AS [2018-03], Sum(IIf([Required Date]=""2018-04"",""1"",""0"")) AS [2018-04], Sum(IIf([Required Date]=""2018-05"",""1"",""0"")) AS [2018-05], Sum(IIf([Required Date]=""2018-06"",""1"",""0"")) AS [2018-06], Sum(IIf([Required Date]=""2018-07"",""1"",""0"")) AS [2018-07], Sum(IIf([Required Date]=""2018-08"",""1"",""0"")) AS [2018-08], " & _
"Sum(IIf([Required Date]=""2018-09"",""1"",""0"")) AS [2018-09], Sum(IIf([Required Date]=""2018-10"",""1"",""0"")) AS [2018-10], Sum(IIf([Required Date]=""2018-11"",""1"",""0"")) AS [2018-11], Sum(IIf([Required Date]=""2018-12"",""1"",""0"")) AS [2018-12] " & vbCrLf & _
"FROM ItmsCheckOutbyMonthtbl LEFT JOIN OfficeInformation ON ItmsCheckOutbyMonthtbl.Office = OfficeInformation.Office " & vbCrLf & _
"WHERE (((ItmsCheckOutbyMonthtbl.[Required Date]) Between '" & [Forms]![CDB_INDV]![Begin-Date] & "' And '" & [Forms]![CDB_INDV]![End-Date] & "')AND ((ItmsCheckOutbyMonthtbl.Received) Is Null)) " & vbCrLf & _
"GROUP BY ItmsCheckOutbyMonthtbl.Office, ItmsCheckOutbyMonthtbl.Name, OfficeInformation.LeadAddress, OfficeInformation.LeadEAddress;"




Set rs = CurrentDb.OpenRecordset(strSQL) ''add your query here
Set rs2 = CurrentDb.OpenRecordset(strSQL2)
'Set rs3 = CurrentDb.OpenRecordset(strSQL3)

rs.MoveLast
SysCmd acSysCmdInitMeter, "Please wait sending emails...", rs.RecordCount
rs.MoveFirst

With rs

If .EOF And .BOF Then
MsgBox "No emails will be sent becuase there are no records assigned from the list", vbInformation
Else
Do Until .EOF



   stremail = ![LeadEAddress] ''Query2 Fields [email];  [Address];  [Name]
    strsubject = "Item checked out " & !Office
    strbody = "Sir/Ma'am," & vbCr & vbCr & "This email is to notify you that they are currently " & ![# of Personnel] & " Personnel that are due for CDBs between " & [Forms]![CDB_INDV]![Begin-Date] & " And " & [Forms]![CDB_INDV]![End-Date] & " ." & vbCr & _
"The Following are the break down in Numbers:" & vbCr & vbCr & "Reporting: " & !reporting & vbCr & "24 Months: " & ![24 Month] & vbCr & "Biennial: " & ![Biennial] & vbCr & "36 Month: " & ![36 Month] & vbCr & "48 Month: " & ![48 Month] & vbCr & "60 Month: " & ![60 Month] & vbCr & "72 Month: " & ![72 Month] & vbCr & vbCr & _
"The Following are the break down in Personnel pending:" & "The Group of names that checked out items based upon the " & !Office & vbCr & _
"If any questions please let me know." & vbCr & vbCr & "Thank you in advance for your support in this matter." & vbCr & vbCr & Forms![EMAIL_DATA]![Email_Comments]



    
On Error Resume Next
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
    .To = stremail
    .CC = ""
    .BCC = ""
    .Subject = strsubject
    .Body = strbody

    .SendUsingAccount = OutApp.Session.Accounts.Item(2)
    .Display
    '.Send
        End With
        'Update the progress bar
    n = n + 1
    SysCmd acSysCmdUpdateMeter, n
            .MoveNext
Loop

'On Error GoTo 0

If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If



Set OutMail = Nothing
Set OutApp = Nothing
SysCmd (acSysCmdRemoveMeter)
    
    DoCmd.SetWarnings True

End If
End With

 

[Minty]

Well that certainly looks like it will work, are you getting any problems?

If you are then the first thing you need to do is remove the set warnings off , as that will hide any error messages.

 

[giddyhead]

I have not had a chance to use the .send function on 2010 however will do it tomorrow. The only thing that I have is how can I get the group of names added to the body of the email that checked out items from a department. Also the following is the code that has the fields that I will like to use the Title and Name field.

strSQL3 = "SELECT ItmsCheckOutbyMonthtbl.Office, ItmsCheckOutbyMonthtbl.Title, ItmsCheckOutbyMonthtbl.[COLOR="Red"]Name[/COLOR], Count(ItmsCheckOutbyMonthtbl.Office) AS [# of Personnel], Sum(IIf([Reason]=""Reporting"",""1"",""0"")) AS Reporting, Sum(IIf([Reason]=""24 Month"",""1"",""0"")) AS [24 Month], Sum(IIf([Reason]=Left([reason],8)=""Biennial"",""1"",""0"")) AS Biennial, Sum(IIf([Reason]=""36 Month"",""1"",""0"")) AS [36 Month], Sum(IIf([Reason]=""48 Month"",""1"",""0"")) AS [48 Month], Sum(IIf([Reason]=""60 Month"",""1"",""0"")) AS [60 Month], Sum(IIf([Reason]=""72 Month"",""1"",""0"")) AS [72 Month], OfficeInformation.LeadAddress, OfficeInformation.LeadEAddress, Sum(IIf([Required Date]=""2016-12"",""1"",""0"")) AS [2016-12], Sum(IIf([Required Date]=""2017-01"",""1"",""0"")) AS [2017-01], Sum(IIf([Required Date]=""2017-02"",""1"",""0"")) AS [2017-02], Sum(IIf([Required Date]=""2017-03"",""1"",""0"")) AS [2017-03], Sum(IIf([Required Date]=""2017-04"",""1"",""0"")) AS [2017-04], " & _
"Sum(IIf([Required Date]=""2017-05"",""1"",""0"")) AS [2017-05], Sum(IIf([Required Date]=""2017-06"",""1"",""0"")) AS [2017-06], Sum(IIf([Required Date]=""2017-07"",""1"",""0"")) AS [2017-07], Sum(IIf([Required Date]=""2017-08"",""1"",""0"")) AS [2017-08], Sum(IIf([Required Date]=""2017-09"",""1"",""0"")) AS [2017-09], Sum(IIf([Required Date]=""2017-10"",""1"",""0"")) AS [2017-10], Sum(IIf([Required Date]=""2017-11"",""1"",""0"")) AS [2017-11], Sum(IIf([Required Date]=""2017-12"",""1"",""0"")) AS [2017-12], Sum(IIf([Required Date]=""2018-01"",""1"",""0"")) AS [2018-01], Sum(IIf([Required Date]=""2018-02"",""1"",""0"")) AS [2018-02], Sum(IIf([Required Date]=""2018-03"",""1"",""0"")) AS [2018-03], Sum(IIf([Required Date]=""2018-04"",""1"",""0"")) AS [2018-04], Sum(IIf([Required Date]=""2018-05"",""1"",""0"")) AS [2018-05], Sum(IIf([Required Date]=""2018-06"",""1"",""0"")) AS [2018-06], Sum(IIf([Required Date]=""2018-07"",""1"",""0"")) AS [2018-07], " & _
"Sum(IIf([Required Date]=""2018-08"",""1"",""0"")) AS [2018-08], Sum(IIf([Required Date]=""2018-09"",""1"",""0"")) AS [2018-09], Sum(IIf([Required Date]=""2018-10"",""1"",""0"")) AS [2018-10], Sum(IIf([Required Date]=""2018-11"",""1"",""0"")) AS [2018-11], Sum(IIf([Required Date]=""2018-12"",""1"",""0"")) AS [2018-12] " & vbCrLf & _
"FROM ItmsCheckOutbyMonthtbl LEFT JOIN OfficeInformation ON ItmsCheckOutbyMonthtbl.Office = OfficeInformation.Office " & vbCrLf & _
"WHERE (((ItmsCheckOutbyMonthtbl.[Required Date])  Between '" & [Forms]![CDB_INDV]![Begin-Date] & "' And '" & [Forms]![CDB_INDV]![End-Date] & "') AND ((ItmsCheckOutbyMonthtbl.Received) Is Null)) " & vbCrLf & _
"GROUP BY ItmsCheckOutbyMonthtbl.Office, ItmsCheckOutbyMonthtbl.Title, ItmsCheckOutbyMonthtbl.Name, OfficeInformation.LeadAddress, OfficeInformation.LeadEAddress;"

Thanks

 

[giddyhead]

When I use the .send function the it somewhat has a false positive it runs through with no issues however it does not send any emails.

In addition in the following:

stremail = ![LeadEAddress] ''Query2 Fields [email];  [Address];  [Name]
    strsubject = "Item checked out " & !Office
    strbody = "Sir/Ma'am," & vbCr & vbCr & "This email is to notify you that they are currently " & ![# of Personnel] & " Personnel that are due for CDBs between " & [Forms]![CDB_INDV]![Begin-Date] & " And " & [Forms]![CDB_INDV]![End-Date] & " ." & vbCr & _
"The Following are the break down in Numbers:" & vbCr & vbCr & "Reporting: " & !reporting & vbCr & "24 Months: " & ![24 Month] & vbCr & "Biennial: " & ![Biennial] & vbCr & "36 Month: " & ![36 Month] & vbCr & "48 Month: " & ![48 Month] & vbCr & "60 Month: " & ![60 Month] & vbCr & "72 Month: " & ![72 Month] & vbCr & vbCr & _
"The Following are the break down in Personnel pending:" & "The Group of names that checked out items based upon the " & !Office & vbCr & _
"If any questions please let me know." & vbCr & vbCr & "Thank you in advance for your support in this matter." & vbCr & vbCr & Forms![EMAIL_DATA]![Email_Comments]

In addition wanted to know how can I use a recordset to put the names of the people that checked out items into the group email based upon their Office for example "The Following are the break down in Personnel pending:" & vbcr& Mr. Joe &vbcr& Mrs. Jane &vbcr& Mr. James. Thanks

 

[Minty]

Can you add a debug.print stremail and see what it is pulling as an actual email address?

 

[giddyhead]

When the use of

strSQL = "SELECT ItmsCheckOutbyMonthtbl.Office, Count(ItmsCheckOutbyMonthtbl.Office) AS [# of Personnel], Sum(IIf([Reason]=""Reporting"",""1"",""0"")) AS Reporting, Sum(IIf([Reason]=""24 Month"",""1"",""0"")) AS [24 Month], Sum(IIf([Reason]=Left([reason],8)=""Biennial"",""1"",""0"")) AS Biennial, Sum(IIf([Reason]=""36 Month"",""1"",""0"")) AS [36 Month], Sum(IIf([Reason]=""48 Month"",""1"",""0"")) AS [48 Month], Sum(IIf([Reason]=""60 Month"",""1"",""0"")) AS [60 Month], Sum(IIf([Reason]=""72 Month"",""1"",""0"")) AS [72 Month], OfficeInformation.LeadAddress, OfficeInformation.LeadEAddress, Sum(IIf([Required Date]=""2016-12"",""1"",""0"")) AS [2016-12], Sum(IIf([Required Date]=""2017-01"",""1"",""0"")) AS [2017-01], Sum(IIf([Required Date]=""2017-02"",""1"",""0"")) AS [2017-02], Sum(IIf([Required Date]=""2017-03"",""1"",""0"")) AS [2017-03], Sum(IIf([Required Date]=""2017-04"",""1"",""0"")) AS [2017-04], Sum(IIf([Required Date]=""2017-05"",""1"",""0"")) AS [2017-05], " & _
"Sum(IIf([Required Date]=""2017-06"",""1"",""0"")) AS [2017-06], Sum(IIf([Required Date]=""2017-07"",""1"",""0"")) AS [2017-07], Sum(IIf([Required Date]=""2017-08"",""1"",""0"")) AS [2017-08], Sum(IIf([Required Date]=""2017-09"",""1"",""0"")) AS [2017-09], Sum(IIf([Required Date]=""2017-10"",""1"",""0"")) AS [2017-10], Sum(IIf([Required Date]=""2017-11"",""1"",""0"")) AS [2017-11], Sum(IIf([Required Date]=""2017-12"",""1"",""0"")) AS [2017-12], Sum(IIf([Required Date]=""2018-01"",""1"",""0"")) AS [2018-01], Sum(IIf([Required Date]=""2018-02"",""1"",""0"")) AS [2018-02], Sum(IIf([Required Date]=""2018-03"",""1"",""0"")) AS [2018-03], Sum(IIf([Required Date]=""2018-04"",""1"",""0"")) AS [2018-04], Sum(IIf([Required Date]=""2018-05"",""1"",""0"")) AS [2018-05], Sum(IIf([Required Date]=""2018-06"",""1"",""0"")) AS [2018-06], Sum(IIf([Required Date]=""2018-07"",""1"",""0"")) AS [2018-07], Sum(IIf([Required Date]=""2018-08"",""1"",""0"")) AS [2018-08], " & _
"Sum(IIf([Required Date]=""2018-09"",""1"",""0"")) AS [2018-09], Sum(IIf([Required Date]=""2018-10"",""1"",""0"")) AS [2018-10], Sum(IIf([Required Date]=""2018-11"",""1"",""0"")) AS [2018-11], Sum(IIf([Required Date]=""2018-12"",""1"",""0"")) AS [2018-12] " & vbCrLf & _
"FROM ItmsCheckOutbyMonthtbl LEFT JOIN OfficeInformation ON ItmsCheckOutbyMonthtbl.Office = OfficeInformation.Office " & vbCrLf & _
"WHERE (((ItmsCheckOutbyMonthtbl.[Required Date]) Between '" & [Forms]![CDB_INDV]![Begin-Date] & "' And '" & [Forms]![CDB_INDV]![End-Date] & "')  AND ((ItmsCheckOutbyMonthtbl.Received) Is Null)) " & vbCrLf & _
"GROUP BY ItmsCheckOutbyMonthtbl.Office, OfficeInformation.LeadAddress, OfficeInformation.LeadEAddress;"

Only One email pulls up for the group which is what I want however when I use

strSQL2 = "SELECT ItmsCheckOutbyMonthtbl.Office, ItmsCheckOutbyMonthtbl.Title, ItmsCheckOutbyMonthtbl.Name, Count(ItmsCheckOutbyMonthtbl.Office) AS [# of Personnel], Sum(IIf([Reason]=""Reporting"",""1"",""0"")) AS Reporting, Sum(IIf([Reason]=""24 Month"",""1"",""0"")) AS [24 Month], Sum(IIf([Reason]=Left([reason],8)=""Biennial"",""1"",""0"")) AS Biennial, Sum(IIf([Reason]=""36 Month"",""1"",""0"")) AS [36 Month], Sum(IIf([Reason]=""48 Month"",""1"",""0"")) AS [48 Month], Sum(IIf([Reason]=""60 Month"",""1"",""0"")) AS [60 Month], Sum(IIf([Reason]=""72 Month"",""1"",""0"")) AS [72 Month], OfficeInformation.LeadAddress, OfficeInformation.LeadEAddress, Sum(IIf([Required Date]=""2016-12"",""1"",""0"")) AS [2016-12], Sum(IIf([Required Date]=""2017-01"",""1"",""0"")) AS [2017-01], Sum(IIf([Required Date]=""2017-02"",""1"",""0"")) AS [2017-02], Sum(IIf([Required Date]=""2017-03"",""1"",""0"")) AS [2017-03], Sum(IIf([Required Date]=""2017-04"",""1"",""0"")) AS [2017-04], " & _
"Sum(IIf([Required Date]=""2017-05"",""1"",""0"")) AS [2017-05], Sum(IIf([Required Date]=""2017-06"",""1"",""0"")) AS [2017-06], Sum(IIf([Required Date]=""2017-07"",""1"",""0"")) AS [2017-07], Sum(IIf([Required Date]=""2017-08"",""1"",""0"")) AS [2017-08], Sum(IIf([Required Date]=""2017-09"",""1"",""0"")) AS [2017-09], Sum(IIf([Required Date]=""2017-10"",""1"",""0"")) AS [2017-10], Sum(IIf([Required Date]=""2017-11"",""1"",""0"")) AS [2017-11], Sum(IIf([Required Date]=""2017-12"",""1"",""0"")) AS [2017-12], Sum(IIf([Required Date]=""2018-01"",""1"",""0"")) AS [2018-01], Sum(IIf([Required Date]=""2018-02"",""1"",""0"")) AS [2018-02], Sum(IIf([Required Date]=""2018-03"",""1"",""0"")) AS [2018-03], Sum(IIf([Required Date]=""2018-04"",""1"",""0"")) AS [2018-04], Sum(IIf([Required Date]=""2018-05"",""1"",""0"")) AS [2018-05], Sum(IIf([Required Date]=""2018-06"",""1"",""0"")) AS [2018-06], Sum(IIf([Required Date]=""2018-07"",""1"",""0"")) AS [2018-07], " & _
"Sum(IIf([Required Date]=""2018-08"",""1"",""0"")) AS [2018-08], Sum(IIf([Required Date]=""2018-09"",""1"",""0"")) AS [2018-09], Sum(IIf([Required Date]=""2018-10"",""1"",""0"")) AS [2018-10], Sum(IIf([Required Date]=""2018-11"",""1"",""0"")) AS [2018-11], Sum(IIf([Required Date]=""2018-12"",""1"",""0"")) AS [2018-12] " & vbCrLf & _
"FROM ItmsCheckOutbyMonthtbl LEFT JOIN OfficeInformation ON ItmsCheckOutbyMonthtbl.Office = OfficeInformation.Office " & vbCrLf & _
"WHERE (((ItmsCheckOutbyMonthtbl.[Required Date])  Between '" & [Forms]![CDB_INDV]![Begin-Date] & "' And '" & [Forms]![CDB_INDV]![End-Date] & "') AND ((ItmsCheckOutbyMonthtbl.Received) Is Null)) " & vbCrLf & _
"GROUP BY ItmsCheckOutbyMonthtbl.Office, ItmsCheckOutbyMonthtbl.Title, ItmsCheckOutbyMonthtbl.Name, OfficeInformation.LeadAddress, OfficeInformation.LeadEAddress;"

multiple emails pull up for the same office I believe it is due to the Name and Title in the SQL2. What I will like to have accomplish is to have all the names and title from the Office added to the body of the email. Thanks

 

[Minty]

Name (and possibly Title) are a reserved word in access I think, put some brackets around it [Name].

You can't pull multiple records into one query line. You will need to concatenate the data you need before hand and insert that into your body string. I would either make a function to return the associated names in a string based on the record id, or you can open a recordset and build the names list from it by looping around it.

 

[giddyhead]

I came up with this

 Dim Office As String, Titles As String
Set rs4 = CurrentDb.OpenRecordset(strSQL3)

  If Not rs4.EOF Then
    Do
      Titles = Titles & rs4![Name] & vbcr 
      rs4.MoveNext
    Loop Until rs4.EOF
    MsgBox Titles
     End If

However I pulls everyone I trying to pull only the names from the office group for example if Admin has 4 names want to pull all 4 then paste into body of email then IT # of personnel, etc? How can I modify it to make it do it. Thanks.

 

[Minty]

So if you run strSQL3 in a normal query window what results do you get. You probably need to add an extra criteria to restrict it to the current record returned in the previous recordsets.

 

[giddyhead]

When I run the strSQL3 I get all of the Names not the names within the specified Office.

 

[Minty]

You need to change that query to get the results set you need.

I also think you could set up a saved totals query to give you the counts per month dynamically, rather than running all those IIf statements. You could then create a Query on that based on the form data.

 

[giddyhead]

I am currently having difficulty with the modification. I have tried modifying delete and replace and I am having no Joy with it. If possible may I request your assistance in providing an example to it? Thanks