NauticalGent
Ignore List Poster Boy
- Local time
- Today, 07:53
- Joined
- Apr 27, 2015
- Messages
- 6,635
Same line? If so, please show the complete SQL ststement...
.HTMLBody = Replace(.HTMLBody, "%Call1%", clientRST.Fields("C1"))
.HTMLBody = Replace(.HTMLBody, "%Call2%", clientRST.Fields("C2"))
.HTMLBody = Replace(.HTMLBody, "%Call3%", clientRST.Fields("C3"))
Private Sub ClientStatus_Change()
Dim sStatus As String
sStatus = Me!ClientStatus & ""
If sStatus <> "NPW - No Contact" And sStatus <> "NPW - Gone Elsewhere" And sStatus <> "NPW - Unable to Place" Then
Exit Sub
End If
If MsgBox("Would you like to send a refund request for this lead?", vbQuestion + vbYesNo + vbDefaultButton1, "Request refund?") = vbNo Then
Exit Sub
End If
Me.Refresh
Dim appOutlook As Outlook.Application
Dim MailOutlook As Outlook.MailItem
Dim strSQL As String
Dim clientRST As Variant
Dim salesRST As Variant
Dim strTable As String
Dim i As Variant
Dim strPaths() As String
strSQL = "SELECT [CustomerID], [Broker], [Lead_Date], [Client_FN], [Client_SN], [Email_Address], [Mobile_No], [Email_Sent], [SMS/WhatsApp_Sent], Nz([Phone_Call_#1], ''), Nz([Phone_Call_#2], '') AS C2, Nz([Phone_Call_#3], '') AS C3 FROM Client" _
& " WHERE CustomerID = " & Forms!CopyExistingLeadF!CustomerID
Set clientRST = CurrentDb.OpenRecordset(strSQL)
Do While Not clientRST.EOF
Set appOutlook = CreateObject("Outlook.application")
Set MailOutlook = appOutlook.CreateItemFromTemplate(Application.CurrentProject.path & "\RefundRequest.oft")
strSQL = "SELECT NoteDate, Note" _
& " FROM NoteHistory" _
& " WHERE CustomerID = " & clientRST!CustomerID
Set salesRST = CurrentDb.OpenRecordset(strSQL)
' TABLE COLUMNS
strTable = "<table><th>"
For i = 0 To salesRST.Fields.Count - 1
strTable = strTable & "<td>" & "</td>"
Next i
strTable = strTable & "</th>"
' TABLE ROWS
salesRST.MoveFirst
While Not salesRST.EOF
strTable = strTable & "<tr>"
For i = 1 To salesRST.Fields.Count
strTable = strTable & "<td>" & salesRST.Fields(i - 1).Value & "</td>"
Next i
strTable = strTable & "</tr>"
salesRST.MoveNext
Wend
strTable = strTable & "</table>"
salesRST.Close
strSQL = "SELECT [FileName] FROM ContactProofT" _
& " WHERE CustomerID = " & Forms!CopyExistingLeadF!CustomerID
strPaths = Split(SimpleCSV(strSQL), ",")
With MailOutlook
.To = "test@test.com"
.subject = "Refund Request"
Dim x As Long
For x = 0 To UBound(strPaths)
.Attachments.Add CurrentProject.path & "\ContactProofs\" & strPaths(x)
Next
' REPLACE PLACEHOLDERS
.HTMLBody = Replace(.HTMLBody, "%date%", clientRST![Lead_Date])
.HTMLBody = Replace(.HTMLBody, "%first%", clientRST![Client_FN])
.HTMLBody = Replace(.HTMLBody, "%surname%", clientRST![Client_SN])
.HTMLBody = Replace(.HTMLBody, "%mobile%", clientRST![Mobile_No])
.HTMLBody = Replace(.HTMLBody, "%email%", clientRST![Email_Address])
.HTMLBody = Replace(.HTMLBody, "%Call1%", clientRST.Fields("C1"))
.HTMLBody = Replace(.HTMLBody, "%Call2%", clientRST.Fields("C2"))
.HTMLBody = Replace(.HTMLBody, "%Call3%", clientRST.Fields("C3"))
.HTMLBody = Replace(.HTMLBody, "%unsuccessful%", clientRST!Email_Sent)
.HTMLBody = Replace(.HTMLBody, "%message%", clientRST![SMS/WhatsApp_Sent])
.HTMLBody = Replace(.HTMLBody, "%Broker%", clientRST![Broker])
' ADD SALES TABLE
.HTMLBody = Replace(.HTMLBody, "%Notes%", strTable)
.Display
End With
Set MailOutlook = Nothing
clientRST.MoveNext
Loop
clientRST.Close
Set clientRST = Nothing
DoCmd.Close acForm, "CopyExistingLeadF"
End Sub
Ah, I see that now. Thanks...No, the VBA SQL has FROM Client.
?FROM Client" _
Whooohoooo thats working for the email body from 'Client' table THANK YOU SO MUCH ...................but still have null issue with notes i.e. if no notes are entered get an error at this point here:Okay, maybe put query back to the original and handle the Null in VBA
.HTMLBody = Replace(.HTMLBody, "%Call1%", Nz(clientRST![Phone_Call_#1], "")
No, the VBA SQL has FROM Client.
salesRST.MoveFirst
Doh! My bag apologies completely didn't see thatWhy don't you use the code suggested in post 51? What is not clear about the suggestion?
Private Sub ClientStatus_Change()
Dim sStatus As String
sStatus = Me!ClientStatus & ""
If sStatus <> "NPW - No Contact" And sStatus <> "NPW - Gone Elsewhere" And sStatus <> "NPW - Unable to Place" Then
Exit Sub
End If
If MsgBox("Would you like to send a refund request for this lead?", vbQuestion + vbYesNo + vbDefaultButton1, "Request refund?") = vbNo Then
Exit Sub
End If
Me.Refresh
Dim appOutlook As Outlook.Application
Dim MailOutlook As Outlook.MailItem
Dim strSQL As String
Dim clientRST As Variant
Dim salesRST As Variant
Dim strTable As String
Dim i As Variant
Dim strPaths() As String
strSQL = "SELECT [CustomerID], [Broker], [Lead_Date], [Client_FN], [Client_SN], [Email_Address], [Mobile_No], [Email_Sent], [SMS/WhatsApp_Sent], [Phone_Call_#1], [Phone_Call_#2], [Phone_Call_#3] FROM Client" _
& " WHERE CustomerID = " & Forms!CopyExistingLeadF!CustomerID
Set clientRST = CurrentDb.OpenRecordset(strSQL)
Do While Not clientRST.EOF
Set appOutlook = CreateObject("Outlook.application")
Set MailOutlook = appOutlook.CreateItemFromTemplate(Application.CurrentProject.path & "\RefundRequest.oft")
strSQL = "SELECT NoteDate, Note" _
& " FROM NoteHistory" _
& " WHERE CustomerID = " & clientRST!CustomerID
Set salesRST = CurrentDb.OpenRecordset(strSQL)
' TABLE COLUMNS
strTable = "<table><th>"
For i = 0 To salesRST.Fields.Count - 1
strTable = strTable & "<td>" & "</td>"
Next i
strTable = strTable & "</th>"
' TABLE ROWS
If Not salesRST.EOF And Not salesRST.EOF Then salesRST.MoveFirst
While Not salesRST.EOF
strTable = strTable & "<tr>"
For i = 1 To salesRST.Fields.Count
strTable = strTable & "<td>" & salesRST.Fields(i - 1).Value & "</td>"
Next i
strTable = strTable & "</tr>"
salesRST.MoveNext
Wend
strTable = strTable & "</table>"
salesRST.Close
strSQL = "SELECT [FileName] FROM ContactProofT" _
& " WHERE CustomerID = " & Forms!CopyExistingLeadF!CustomerID
strPaths = Split(SimpleCSV(strSQL), ",")
With MailOutlook
.To = "test@test.com"
.subject = "Refund Request"
Dim x As Long
For x = 0 To UBound(strPaths)
.Attachments.Add CurrentProject.path & "\ContactProofs\" & strPaths(x)
Next
' REPLACE PLACEHOLDERS
.HTMLBody = Replace(.HTMLBody, "%date%", clientRST![Lead_Date])
.HTMLBody = Replace(.HTMLBody, "%first%", clientRST![Client_FN])
.HTMLBody = Replace(.HTMLBody, "%surname%", clientRST![Client_SN])
.HTMLBody = Replace(.HTMLBody, "%mobile%", clientRST![Mobile_No])
.HTMLBody = Replace(.HTMLBody, "%email%", clientRST![Email_Address])
.HTMLBody = Replace(.HTMLBody, "%Call1%", Nz(clientRST![Phone_Call_#1], ""))
.HTMLBody = Replace(.HTMLBody, "%Call2%", Nz(clientRST![Phone_Call_#2], ""))
.HTMLBody = Replace(.HTMLBody, "%Call3%", Nz(clientRST![Phone_Call_#3], ""))
.HTMLBody = Replace(.HTMLBody, "%unsuccessful%", Nz(clientRST!Email_Sent, ""))
.HTMLBody = Replace(.HTMLBody, "%message%", Nz(clientRST![SMS/WhatsApp_Sent], ""))
.HTMLBody = Replace(.HTMLBody, "%Broker%", Nz(clientRST![Broker], ""))
' ADD SALES TABLE
.HTMLBody = Replace(.HTMLBody, "%Notes%", strTable)
.Display
End With
Set MailOutlook = Nothing
clientRST.MoveNext
Loop
clientRST.Close
Set clientRST = Nothing
DoCmd.Close acForm, "CopyExistingLeadF"
End Sub