Code:
Dim MyApp As New Outlook.Application
Dim MyItem As Outlook.MailItem
Dim MyInput As Integer, RecNo As Integer
Dim MailBody As String, MailTo As String, Subj As String, ClientName As String, mDriver As String, fNameDriver As String
Dim FullName As String, fName As String, TimeNow As String, TOD As String, Product As String, DriverNo As String
Dim NewTest As String, fSave As String, pSave As String, fOpen As String, pOpen As String
Dim RemDate As Date
Dim xlApp As Excel.Application
Dim xlWB As Object
Dim cValue As Currency, pValue As Currency, RecValue As Currency
Dim mFOC As Variant
TimeNow = Format(Now(), "hh:nn")
If TimeNow <= "11:59" Then
If TimeNow >= "00:01" Then
TOD = "Good morning"
End If
End If
If TimeNow <= "16:59" Then
If TimeNow >= "12:01" Then
TOD = "Good afternoon"
End If
End If
If TimeNow <= "23:59" Then
If TimeNow >= "17:01" Then
TOD = "Good evening"
End If
End If
RecNo = Me.RecordNo
MailTo = Me.EMail
ClientName = Me.Client
RemDate = Me.Date
Product= Me.Make
FullName = ClientName
fName = Left(MyString, InStr(MyString, " "))
NewTest = "http://www.ourwebsite/new-testimonial"
MyInput = InputBox("Enter What You Want To Email:" & vbNewLine & vbNewLine & _
ClientName & " " & "?" & vbNewLine & vbNewLine & _
" 1 = Send Booking Confirmation" & vbNewLine & vbNewLine & _
" 2 = Send An Invoice For Product" & vbNewLine & vbNewLine & _
" 3 = Send Receipt For Product" & vbNewLine & vbNewLine & _
" 4 = Request A Website Testimonial", "EMAIL OPTIONS")
Select Case MyInput
Case 1
If IsNull(DLookup("Engineer", "tblRemovals", "[RecordNo] = " & RecNo)) Then
If MsgBox("There Is No Engineer Allocated For:" & vbNewLine & vbNewLine & _
RemDate & " " & ClientName & vbNewLine & vbNewLine & _
"Abort Sending Removal Confirmation Now ?", vbQuestion + vbYesNo, "NO ENGINEER ALLOCATED") = vbYes Then
DoCmd.CancelEvent
End If
End If
If Not IsNull(DLookup("Engineer", "tblRemovals", "[RecordNo] = " & RecNo)) Then
mDriver = Me.Engineer
DriverNo = DLookup("Tel", "tblDrivers", "[Driver] = '" & mDriver & "'")
fNameDriver = Left(mDriver, InStr(mDriver, " "))
MailBody = TOD & " " & fName & ", " & "we are writing to you to confirm your" & " " & Product & " " & "removal booking with us." & vbNewLine & vbNewLine & _
"The date we have scheduled for you is " & Format(RemDate, "dddd-dd-mmm-yyyy") & vbNewLine & vbNewLine & _
"The engineer allocated to remove your " & Product & " " & "is called: " & mDriver & "." & vbNewLine & vbNewLine & _
fNameDriver & " " & "will update you on route from his appointment prior to yours" & vbNewLine & vbNewLine & _
"If you wish to make direct contact with: " & fNameDriver & " " & "the mobile number is: " & DriverNo & vbNewLine & vbNewLine & _
"Thank you for booking with us." & vbNewLine & vbNewLine & _
"Please feel free to leave us your review once your " & Product & " " & "has been removed by clicking here >" & " " & NewTest
Set MyItem = MyApp.CreateItem(olMailItem)
With MyItem
.To = MailTo
.Body = MailBody
.Subject = "Product removal date"
.Display
End With
End If
Case 3
Forms!frmMainMenu!txtRecNoCriteria = RecNo
If Me.TotalValue = "0" Then
If Me.Charge = "0" Then
mFOC = "Yes"
Else
mFOC = ""
End If
End If
pOpen = "T:\XL Files\RECEIPTS\"
fOpen = "RECEIPT TEMPLATE" & ".xlsx"
pSave = "T:\XL Files\RECEIPTS\"
fSave = "Receipt-" & " " & RecNo & ".xlsx"
Set apXL = CreateObject("Excel.Application")
Set xlWB = apXL.Workbooks.Open(pOpen & fOpen)
apXL.ActiveWorkbook.SaveAs pSave & fSave
apXL.Workbooks.Open pSave & fSave, True, False
apXL.Visible = True
With xlWB
.Worksheets(1).Cells(2, 9) = RecNo
.Worksheets(1).Cells(4, 9) = RemDate
.Worksheets(1).Cells(6, 9) = mClient
.Worksheets(1).Cells(7, 9) = Me.Add1
.Worksheets(1).Cells(8, 9) = Me.Add2
.Worksheets(1).Cells(9, 9) = Me.Town
.Worksheets(1).Cells(10, 9) = Me.PostCode
.Worksheets(1).Cells(13, 3) = Product
.Worksheets(1).Cells(15, 9) = mClient
.Worksheets(1).Cells(20, 9) = Me.Charge
.Worksheets(1).Cells(22, 9) = mFOC
.Worksheets(1).Cells(24, 9) = Me.TotalValue
.Save
xlWB.Close
apXL.Quit
Set apXL = Nothing
If MsgBox("Receipt " & RecNo & " " & "Has Created Successfully" & Chr(10) & Chr(10) & _
"Do You Want To Open It To Check Data ?", vbQuestion + vbYesNo, "FILE CREATED") = vbNo Then
DoCmd.CancelEvent
Else
Set apXL = CreateObject("Excel.Application")
Set xlWB = apXL.Workbooks.Open(pSave & fSave)
apXL.Workbooks.Open pSave & fSave, True, False
apXL.Visible = True
DoCmd.RunCommand acCmdAppMinimize
End If
If MsgBox("Email Receipt " & RecNo & " " & "To " & mClient & " " & "Now ?", vbQuestion + vbYesNo, "EMAIL RECEIPT") = vbNo Then
DoCmd.CancelEvent
Else
MailBody = TOD & " " & fName & ", " & "Thank you for choosing us to remove your product recently," & vbNewLine & vbNewLine & _
"PLease find atttached your confirmation receipt " & "( " & "Receipt " & RecNo & " " & ") " & " " & "for the completion of the product removal located at: " & Me.PostCode & vbNewLine & vbNewLine & _
"Here at www.ourwebsite.com, we deal with each and every client with extreme pride and would like to know your experience with our services." & vbNewLine & vbNewLine & _
"If you are happy to share your experience with us, please feel free to help our customer services by adding your review." & vbNewLine & vbNewLine & _
"To see what others have written about us, check our current testimonials by clicking here > http://www.ourwebsite.com/testimonials" & vbNewLine & vbNewLine & _
"To add your own review, you can do this direct to us by clicking here >" & " " & NewTest & vbNewLine & vbNewLine & _
"May we take this opportunity to wish you all the best" & vbNewLine & vbNewLine & _
"From all of us at Our Website.com"
Set MyItem = MyApp.CreateItem(olMailItem)
With MyItem
.To = MailTo
.Body = MailBody
.Attachments.Add pSave & fSave
.Subject = "product removal receipt"
.Display
End With
End If
Case 4
MailBody = TOD & " " & fName & ", " & "Thank you for choosing us to remove your product recently," & vbNewLine & vbNewLine & _
"Here at www.ourwebsite.com, we deal with each and every client with extreme pride and would like to know your experience with our services." & vbNewLine & vbNewLine & _
"If you are happy to share your experience with us, please feel free to help our customer services by adding your review." & vbNewLine & vbNewLine & _
"To see what others have written about us, check our current testimonials by clicking here > http://www.ourwebsite.com/testimonials" & vbNewLine & vbNewLine & _
"To add your own review, you can do this direct to us by clicking here >" & " " & NewTest & vbNewLine & vbNewLine & _
"May we take this opportunity to wish you all the best" & vbNewLine & vbNewLine & _
"From all of us at ourwebsite.com"
Set MyItem = MyApp.CreateItem(olMailItem)
With MyItem
.To = MailTo
.Body = MailBody
.Subject = "product removal"
.Display
End With
End Select