I open a UserForm VidEmailForm which gets variables ccPeeps, VidEmailSubject, and VidEmailLink.
This looks correct on .Display. However, when I hit Send it doesn’t send.
I tried .Save which does save it to my Draft folder, but when I try to send that, I get errors.
I used the same code to send a default email. The only difference is the body.
Sub EmailforVids()
ccPeeps = ""
VidEmailForm.Show
Dim EmailApp2 As Object, EmailItem2 As Object
Dim Signature As String, xMailBody As String
Set EmailApp2 = CreateObject("Outlook.application")
Set EmailItem2 = EmailApp2.CreateItem(0)
With EmailItem2
.Display
End With
username = Environ$("USERNAME")
Signature = GetSignature("DART")
currentDate = Format(Now, "yyyymmdd")
If Time < TimeValue("12:00:00") Then
xMailBody = "Good Morning"
ElseIf Time > TimeValue("12:00:00") And Time < TimeValue("17:00:00") Then
xMailBody = "Good Afternoon"
Else
xMailBody = "Good Evening"
End If
With EmailItem2
.To = "(redacted)"
.cc = ccPeeps
.Subject = VidEmailSubject
.HTMLbody = "<BODY style=font-size:12pt;font-family:Aptos>" & xMailBody & ",<br><br>" & "<a href =" & VidEmailLink & ">" & VidEmailSubject & "</a>" & "<br><br>" & _
"Attached Review Players if needed for .cva files:<br><a href=" & """" & "https://redacted.sharepoint.com/:u:/s/tccapps/EbkNE4bZpbJFp2TLvs4cI7cBm1FqQ8WhiuR5191aGXydYA?e=mrKvYs" & """" & ">x64 Player</a>" & _
"<br><a href=" & """" & "https://redacted.sharepoint.com/:u:/s/tccapps/EUKwdQSAtkJDv7tAMn1jvcgB891TeE74yiUfRM4exVReRw?e=wplpxf" & """" & ">win32 Player</a>" & _
"<BR><BR>" & Signature
.Display
.Send
End With
Set EmailItem2 = Nothing
Set EmailApp2 = Nothing
End Sub
6
VBA is not supported by the New Outlook.
It IS enough to just have the old Outlook open as well as new.
Emails are sent correctly.