Code:
Const Q = """"Dim CurrDay As Date, myDay As String, DayNo As Long, OrgDate As Date, DateChange As String, MailBody As String, TimingBody As String, TimeSlot As String, myUser As String, MailBody3 As String
Dim myClient As String, FullName() As String, dte As Date, TOD As String, FriDate As Date, ConDate As Date, myGreet As String, myETA1 As String, myETA2 As String, myEmail As String, MailBody2 As String
Dim rs As DAO.Recordset
Dim MyItem As Outlook.MailItem
Dim OutAccount As Outlook.Account
Dim myApp As New Outlook.Application
Dim BookingLink As String, RecNo As Integer
RecNo = Me.txtRef
myUser = Me.txtLogin
CurrDay = DateAdd("d", -(Weekday(Me.txtDateSource) - DayNo), Me.txtDateSource)
myDay = Format(CurrDay, "dddd-dd-mmm-yyyy")
DateChange = Format(CurrDay, "dd-mm-yyyy")
FriDate = DateAdd("d", -(Weekday(Me.txtDateSource) - 6), Me.txtDateSource)
FullName = Split(Me.txtName, " ")
Select Case UBound(FullName)
Case 0
myClient = FullName(0)
Case 1
myClient = FullName(0)
Case 2
myClient = FullName(0) & " " & FullName(2)
End Select
dte = Format(Now(), "hh:nn")
Select Case TOD
Case Is < TimeValue("12:00")
TOD = "Good morning"
Case Is < TimeValue("17:00")
TOD = "Good afternoon"
Case Else
TOD = "Good evening"
End Select
myGreet = TOD & " " & myClient & ","
BookingLink = "https://www.ourwebsiteremoved.com"
myETA1 = Me.txtETA
myETA2 = Me.txtETA2
TimeSlot = "We have now allocated a buffer time slot to remove your Item Removed Here." & vbNewLine & vbNewLine & _
"Here is the allocation we are offering:" & vbNewLine & vbNewLine & _
"......................................................................................................................." & vbNewLine & _
vbTab & "Removal Date: " & Me.txtDate & vbNewLine & vbNewLine & _
vbTab & "Expected between: " & myETA1 & " and " & Replace(myETA2, ":00", "") & " " & "(Subject To Your Approval)" & vbNewLine & vbNewLine & _
vbTab & "You can view your times online which will be updated on " & Format(Me.txtFriConDate, "dddd-dd-mmm-yyyy") & " " & "mid afternoon onwards" & vbNewLine & vbNewLine & _
"......................................................................................................................." & vbNewLine & _
Chr(149) & " " & "IMPORTANT NOTE" & " " & Chr(149) & vbNewLine & vbNewLine & _
"Due to a very congested phone line, to prevent us missing you, your timings are now offered online also." & vbNewLine & vbNewLine & _
"Due to our privacy policy, there are no names and address on our website that corresponds with your booking, just your unique booking number."
MailBody2 = "Please follow this link "
MailBody3 = "your 4 digit booking number " & "( " & RecNo & " ) will be listed" & vbNewLine & vbNewLine & _
"If you can accommodate the timings offered, please type your reference number " & "(" & RecNo & ")" & " " & "Click 'Confirm Time Button'" & vbNewLine & vbNewLine & _
"We much appreciate this as it helps us whilst our telephone lines are very busy." & vbNewLine & vbNewLine & _
"We thank you for your understanding and we look forward to assisting you" & vbNewLine & vbNewLine & _
"With our kindest regards" & vbNewLine & vbNewLine & _
myUser
MailBody = myGreet & vbNewLine & vbNewLine & _
TimeSlot
Set rs = CurrentDb.OpenRecordset("Select * From tblRemovals WHERE RecordNo = " & RecNo)
With rs
.Edit
!Date = Me.txtDateAdd
!ETA = Me.txtETA
!ETA2 = Me.txtETA2
.Update
.Close
End With
Set rs = Nothing
Me.lstDates.Requery
If Me.cboList = "Email All" Then
MsgBox ("System Updated Ready For Emailing " & myClient), vbInformation + vbOKOnly, "TIMING UPDATED"
End If
If Me.cboList <> "Email All" Then
If Me.txtEmailAddress = "" Then
MsgBox ("There is No Email Address For: " & myClient), vbOKOnly, "NO EMAIL ADDRESS"
myEmail = ""
Else
myEmail = Me.txtEmailAddress
Set MyItem = myApp.CreateItem(olMailItem)
With MyItem
Set OutAccount = myApp.Session.Accounts.Item(2)
.To = myEmail
.HTMLBody = MailBody & vbNewLine & vbNewLine & _
MailBody2 & "<a href=" & Q & BookingLink & Q & ">Click here</a>" & vbNewLine & vbNewLine & _
MailBody3
'.Body = MailBody
.Subject = "Item Removal Date"
.SendUsingAccount = OutAccount
.Display
End With
End If
End If
ranman version