Microsoft Office Forums - View Single Post

Bluewhysper · 12-05-2018, 12:20 PM

Below is the code Is use to generate an email but I cannot modify any of the text to display in red. Please help.

Sub UDI_Upgrade_Scheduled_Email()
'
' UDI_Upgrade_Scheduled_Email Macro
'
'
Dim HTLMBody, FirstName, DayOfTheWeek, CalendarDate, PrimaryAsset, AssetTag, ComputerModel, HostName, Location As String
Dim Building, Floor, Room, ControlNumber, ToEmailAddress, CCEmailAddress, BCEmailAddress, LineForSubject As String
Dim NonStandardSoftware, EngineeringSoftware, CreoSoftware As String
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
FirstName = InputBox("What is the customer's first name? ", "UDI Upgrade Schedules Email - First Name")
ToEmailAddress = InputBox("Please enter the email address for the UDI email: ", "UDI Upgrade Schedule Email - To Email Address", "@lmcp.com")
ControlNumber = InputBox("What is the Control Number? ", "UDI Upgrade Schedule Email - Control Number")
LineForSubject = ("Windows 10 Upgrade #" & ControlNumber & "")
DayOfTheWeek = InputBox("Please enter the day of the week: ", "UDI Upgrade Schedule Email - Day of the Week")
CalendarDate = InputBox("Please enter the calendar date (MM/DD/YY): ", "UDI Upgrade Schedule Email - Calendar Date")
PrimaryAsset = InputBox("Please enter the Asset Use: ", "UDI Upgrade Schedule Email - Primary Asset")
AssetTag = InputBox("Please enter the Asset Tag: ", "UDI Upgrade Schedule Email - Asset Tag")
ComputerModel = InputBox("Please enter the Computer Model: ", "UDI Upgrade Schedule Email - Computer Model")
HostName = InputBox("Please enter the Host Name: ", "UDI Upgrade Schedule Email - Host Name")
Location = InputBox("Please enter the location of the user 1-3: 1 = CO - Deer Creek (DCF), 2 = CO - Louisville (LMCT), 3 = CO - Waterton", "UDI Upgrade Schedule Email - Location")
If Location = "1" Then
Location = "CO - Deer Creek (DCF)"
End If
If Location = "2" Then
Location = "CO - Louisville (LMCT)"
End If
If Location = "3" Then
Location = "CO - Waterton"
End If
Building = InputBox("Please enter the building: ", "UDI Upgrade Schedule Email - Building")
Floor = InputBox("Please enter the floor: ", "UDI Upgrade Schedule Email - Floor")
Room = InputBox("Please enter the Room: ", "UDI Upgrade Schedule Email - Room")
CCEmailAddress = "eus-udi.fc-ssc-it@lmco.com"
On Error Resume Next
With OutMail
.To = "" & ToEmailAddress & ""
.CC = "" & CCEmailAddress & ""
'.BCC = "" & BCCEmailAddress & ""
.Subject = "" & LineForSubject & ""
HTMLBody = "Hi " & FirstName & ", "
HTMLBody = HTMLBody & "Your Windows 10 upgrade has been scheduled for " & DayOfTheWeek & " " & CalendarDate & ". "
HTMLBody = HTMLBody & "We will provide you with a loaner if you need one. "
HTMLBody = HTMLBody & "There will be a backup done before the upgrade and a restore done afterwards. "
CreoSoftware = InputBox("Are there any Creo software modules n this workstation (Y or N)? ", "UDI Upgrade Schedule Email - Creo module verification", "N")
If CreoSoftware = "Y" Or CreoSoftware = "y" Then
HTMLBody = HTMLBody & "All licensed software will be re-installed as a part of this installation (Please reply with Creo modules that are needed) with the following exceptions: "
End If
If CreoSoftware = "N" Or CreoSoftware = "n" Then
HTMLBody = HTMLBody & "All licensed software will be re-installed as a part of this installation with the following exceptions: "
End If
HTMLBody = HTMLBody & "Unlicensed software will not be re-installed on your computer. "
HTMLBody = HTMLBody & "Personally owned software will not be re-installed on your computer. "
HTMLBody = HTMLBody & "Non-standard software already approved by NSPR can be re-installed with the help of the LM Service Desk. "
NonStandardSoftware = InputBox("Is there any non-standard software needing to be manually installed (Y or N)? ", "UDI Upgrade Schedule Email - Maunal Software Query")
If NonStandardSoftware = "Y" Or NonStandardSoftware = "y" Then
HTMLBody = HTMLBody & "The following software will need to be manually installed: "
AnotherNonStandardSoftware:
NonStandardSoftware = InputBox("Enter the name of the software to manually install (Q to quit) ", "UDI Upgrade Schedules Email - Non-Standard Software Name")
Else
GoTo ContinueEmailOne
End If
If NonStandardSoftware = "Q" Or NonStandardSoftware = "q" Then
GoTo ContinueEmailOne
Else
HTMLBody = HTMLBody & "" & NonStandardSoftware & " "
GoTo AnotherNonStandardSoftware
End If
ContinueEmailOne:
HTMLBody = HTMLBody & " "
HTMLBody = HTMLBody & "More information on Non-Standard Products can be found at https://lmsupport.global.lmco.com/Li...Help/NSPR.aspx . "
HTMLBody = HTMLBody & "Asset Use: "
HTMLBody = HTMLBody & "" & PrimaryAsset & " "
HTMLBody = HTMLBody & "Asset Tag: "

HTMLBody = HTMLBody & "" & AssetTag & " "
HTMLBody = HTMLBody & "Computer Model:" & ComputerModel & " "
HTMLBody = HTMLBody & "Computer Name: " & HostName & " "
HTMLBody = HTMLBody & "Location: " & Location & " "
HTMLBody = HTMLBody & "Building: " & Building & " "
HTMLBody = HTMLBody & "Floor: " & Floor & " "
HTMLBody = HTMLBody & "Room: " & Room & " "
HTMLBody = HTMLBody & "Please confirm the asset and location information listed above. "
HTMLBody = HTMLBody & "Is this a closed area? "
HTMLBody = HTMLBody & "The assigned tech will be in contact with you on the day of your upgrade, before the scheduled upgrade starting at 3:30pm please do the following: "
HTMLBody = HTMLBody & "1. Reboot the laptop or desktop. "
HTMLBody = HTMLBody & "2. If you have a laptop please enter the credentials for McAfee Encryption after the reboot. "
HTMLBody = HTMLBody & "3. Login to assure a network connection. "
HTMLBody = HTMLBody & "4. Once your desktop loads you can log off. "
HTMLBody = HTMLBody & "5. Make sure the laptop is on the docking station or plugged into a power cable and network cable. This will not work on wireless or over VPN. "
HTMLBody = HTMLBody & "Once the upgrade is started please do not log back into the laptop/desktop until tomorrow morning. "
.HTMLBody = "" & HTMLBody & ""
.Display
End With
End Sub