SELECT Data.MyDate, Data.Area, Data.Category, Data.Corrective, Data.Status, Data.Respon_P
FROM Data
WHERE (((Data.Status)="Open" Or (Data.Status)="Review") AND ((Data.Respon_P)=[Forms]![Main_Menu]![Combo46]));
and code, that loops through the table, to create HTML..
however, it is erroring out on trying to set the recordsource to this query.
Run-Time error 3061, too few parameters.
With combo36 populated, if i then manually run the query it works perfectly.
It errors out on this line
Set rs = CurrentDb.OpenRecordset("My_Actions_Query2")
Code: Select all
Private Sub Command48_Click()
'Make sure someone is selected
If IsNull(Me.Combo46) Then
MsgBox "You Must Select Someone !", vbExclamation
GoTo EndyBit
End If
Call ClearThem
Dim MyPerson As Integer
Dim HisEmail As String
MyPerson = Me.Combo46
HisEmail = DLookup("Email", "Responsibility", "ID=" & MyPerson)
' MyPerson is the ID of the person in the responsibilities field
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
'On Error Resume Next
Dim f As Long, c As Long
Dim sTable As String
Dim rs As DAO.Recordset
Dim olApp As Outlook.Application
Dim olMsg As Outlook.MailItem
Dim olRecip As Recipient
Dim Recipients As Recipients
Dim qField(1 To 6) 'array
''Table Header
qField(1) = "MyDate"
qField(2) = "Area"
qField(3) = "Category"
qField(4) = "Corrective"
qField(5) = "Status"
qField(6) = "Respon_P"
sTable = "<table border=1 cellspacing=0 style='padding:0in 5.5pt 0in 5.5pt'><tbody>"
sTable = sTable & "<tr bgcolor=""#70ad47""><font color=""Black""><b><td>Date</td>"
sTable = sTable & "<td>Area</td>"
sTable = sTable & "<td>Category</td>"
sTable = sTable & "<td>Corrective</td>"
sTable = sTable & "<td>Status</td>"
sTable = sTable & "<td>Issue</td></b></font></tr>"
''Rows
Set rs = CurrentDb.OpenRecordset("My_Actions_Query2")
Do Until rs.EOF
c = c + 1 'counter for the every other row light green
If c Mod 2 = 0 Then 'every other row light green
sTable = sTable & "<tr style=""background: #e2efd9"">"
Else
sTable = sTable & "<tr>" 'open row
End If
For f = 1 To 6 'cells
sTable = sTable & "<td>" & rs.Fields(qField(f)) & "</td>"
Next
sTable = sTable & "</tr>" 'close row
rs.MoveNext
Loop
sTable = sTable & "</tbody></table>" 'close table
rs.Close
Set rs = Nothing
''Compose Email
Set olApp = CreateObject("Outlook.Application")
Set olMsg = olApp.CreateItem(olMailItem)
olMsg.To = HisEmail
For Each olRecip In olMsg.Recipients
olRecip.Resolve
Next
olMsg.Subject = "Open GMP Actions " & Format(Date, "Medium Date")
If Forms!Main_Menu.Check55 = True Then
olMsg.Display 'This must go before the .HTMLBody line b/c that is the only way to capture the existing default signature.
End If
olMsg.HTMLBody = "<Body><div>Hello,<br>" & _
"Please see Current list of actions in your name below.<br><br>" & sTable & olMsg.HTMLBody
If Forms!Main_Menu.Check55 = False Then
olMsg.Send
End If
EndyBit:
End Sub