parrykrish
New Member
- Joined
- Aug 30, 2024
- Messages
- 1
- Office Version
- 365
- Platform
- Windows
- Mobile
- Web
I've the below code to create outlook teams invite, when i excute it it stops at random 40+ row but I've 200+ invites to be sent on daily basis.
1. Please help me with this code where I went wrong
2. I want a msgbox stating till which row macro has executed.
1. Please help me with this code where I went wrong
2. I want a msgbox stating till which row macro has executed.
VBA Code:
Option Explicit
Sub SetApptWithHTMLContent()
Dim olapp As Outlook.Application, appt As Outlook.AppointmentItem
Dim m As Outlook.MailItem
Dim rtf() As Byte
Dim ml1 As Worksheet
Dim r As Long
Dim j As Long
Dim sh As Worksheet
Set sh = Sheets("Scheduler")
Dim startline As String
Dim t As Long
r = 2
Do
Set olapp = New Outlook.Application
Set m = olapp.CreateItem(olMailItem)
Set appt = olapp.CreateItem(olAppointmentItem)
On Error Resume Next
appt.Subject = "Interview with '" & sh.Cells(r, 3).Value & "' for '" & sh.Cells(r, 4).Value & "' - " & sh.Cells(r, 2).Value & " | on " & Format(sh.Cells(r, 6).Value, "DD-MMM-YYYY") & " at " & Format(sh.Cells(r, 5).Value, "hh:mm AM/PM")
appt.Recipients.Add sh.Cells(r, 9).Value
appt.OptionalAttendees = sh.Cells(r, 10).Value
appt.Start = sh.Cells(r, 6).Value + sh.Cells(r, 5).Value
appt.End = sh.Cells(r, 8).Value + sh.Cells(r, 7).Value
appt.Location = "Microsoft Teams Meeting"
'...set other appointment properties
appt.Display
'put the HTML into the mail item, then copy and paste to appt
m.BodyFormat = olFormatHTML
m.HTMLBody = "<Body style = font-size:12pt, fornt-familt:Arial>" & "Dear " & sh.Cells(r, 2).Value & "," & "<br> Greetings from " & sh.Cells(r, 3).Value & "<p><b><u> Note:</b></u> Please make sure the internet connection and also join through the Laptop." & "<br> You are invited for LIVE video interview as per the below schedule for '" & sh.Cells(r, 4).Value & "' role. <p><b> Topic:</b> " & "Interview with '" & sh.Cells(r, 3).Value & "' for " & "'" & sh.Cells(r, 4).Value & "'" & "<br><b> Time:</b> " & Format(sh.Cells(r, 6).Value, "DD-MMM-YYYY") & " at " & Format(sh.Cells(r, 5).Value, "hh:mm AM/PM") & "<p> Kindly accept the invite and make yourself free to attend the interview, Please feel free to reach out to our team for any clarification required. <p>Thanks and regards <br> Meedenlabs Team on behalf of " & sh.Cells(r, 3).Value
appt.Attachments.Add sh.Cells(r, 12).Value
m.GetInspector().WordEditor.Range.FormattedText.Copy
appt.GetInspector().WordEditor.Range.FormattedText.Paste
'Send Keys to convert Calendar invite to MS Teams invite
SendKeys "{F10}", True
SendKeys "h", True
SendKeys "y1", True
SendKeys "{ENTER}", True
m.Close False 'don't save...
r = r + 1
startline = ""
Loop While Len(sh.Cells(r, 9).Value) > 5
End Sub
Last edited by a moderator:
