NauticalGent
Ignore List Poster Boy
- Local time
- Yesterday, 22:10
- Joined
- Apr 27, 2015
- Messages
- 7,031
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"))
 By enchilada do you mean the code or the DB?
 By enchilada do you mean the code or the DB?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 SubAh, I see that now. Thanks...No, the VBA SQL has FROM Client.
?FROM Client" _
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.


 Whooohoooo thats working for the email body from 'Client' table THANK YOU SO MUCH
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:
 ...................but still have null issue with notes i.e. if no notes are entered get an error at this point here: 
	
	
salesRST.MoveFirstDoh! 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