Dim objOutlook As Outlook.Application
Dim objEmailItem As MailItem
Dim strAddress As String
Dim strClient As String
Dim strHTML As String
Dim rst As Recordset
Dim strQuery As String
Dim val As String
Dim strLast As String
val = [Forms]![frmNavigation]![NavigationSubform]![DealID]
strQuery = "SELECT tblConditions.Stage, tblConditions.Condition, IIf([tblConditions.Stage]='LOI',1," _
& "IIf([tblConditions.Stage]='Rate Lock',2,IIf([tblConditions.Stage]='Appraisal',3,IIf([tblConditions.Stage]='Appraisal Requirement',4," _
& "IIf([tblConditions.Stage]='Final UW',5,IIf([tblConditions.Stage]='Loan Doc',6,IIf([tblConditions.Stage]='Close',7))))))) AS Sort " _
& "FROM tblConditions RIGHT JOIN tblDeals ON tblConditions.DealIDFK = tblDeals.DealID " _
& "WHERE (((tblDeals.DealID) = " & val & ") And ((tblConditions.Status) = 'Pending'))" _
& "ORDER BY IIf([tblConditions.Stage]='LOI',1,IIf([tblConditions.Stage]='Rate Lock',2,IIf([tblConditions.Stage]='Appraisal',3," _
& "IIf([tblConditions.Stage]='Appraisal Requirement',4,IIf([tblConditions.Stage]='Final UW',5,IIf([tblConditions.Stage]='Loan Doc',6,IIf([tblConditions.Stage]='Close',7)))))));"
Set rst = CurrentDb.OpenRecordset(strQuery)
On Error Resume Next
Do Until rst.EOF
If rst.Fields("Stage") <> strLast Then
strLast = rst.Fields("Stage")
strHTML = strHTML & "[COLOR=Red]</ul>[/COLOR]<u>" & strLast & ":</u><br><ul>"
End If
strHTML = strHTML & "<li>" & rst.Fields("Condition") & "</li>"
rst.MoveNext
Loop
strHTML = strHTML & "</ul>"
strAddress = DFirst("Address", "qryConditions")
strClient = DFirst("Name", "qryConditions")
' Prevent 429 Error if outlook is not open
Err.Clear
Set objOutlook = GetObject(, "Outlook.application")
If Err.Number <> 0 Then
Set objOutlook = New Outlook.Application
End If
Set objEmailItem = Outlook.CreateItem(olMailItem)
With objEmailItem
.Subject = "Pending Conditions/Requirements: " & strAddress & " - " & strClient
.To = "email address"
.HTMLBody = "<body style='font-size:11.0pt'><i>Pending Conditions on " & strAddress & ":</i><br><br>" _
& strHTML
.Display
End With
Set objEmailItem = Nothing
Set objOutlook = Nothing