Why won't this send more than one meeting request?

Pasty

Board Regular
Joined
Mar 26, 2007
Messages
96
Hi there,

I have this code in excel which fires off meeting request if the action is a priority one and it is similar to a code that I have for firing off tasks which works perfectly. The problem I am having is that unlike the task code this one doesn't send any more meeting requests after the first one sent and then fills in to say the other meeting request have been sent when they haven't. I've tried stepping through the code but I still can't see what is going wrong. Can anyone help?

Code:
Sub SendMeetingRequest()
    Dim objOL   'As Outlook.Application
    Dim objAppt 'As Outlook.AppointmentItem
    Dim Subject As String
    Dim Body As String
    Dim wkBook As Workbook
    Dim wsMain As Worksheet
    Dim myCell As Range
    Dim myR As Range
    
    Const olAppointmentItem = 1
    Const olMeeting = 1
    
    Set wkBook = ThisWorkbook
    Set wsMain = wkBook.Worksheets("Audit")
    Set myR = wsMain.Range("F2:F20")
    Set objOL = CreateObject("Outlook.Application")
    Set objAppt = objOL.CreateItem(olAppointmentItem)
    
    For Each myCell In myR
    
    If myCell.Value = "Priority 1" And _
         myCell(1, 7).Value <> "Meeting request sent" Then
        
    'Set objAppt = objOL.CreateItem(olAppointmentItem)
       
    With wsMain
    
    Subject = "Priority 1 audit findings - please propose a new time"
    Body = "Action: " & vbCrLf & .Cells(myCell.Row, 5)
    
    End With
       
    Application.ScreenUpdating = False
    
    If Not objOL Is Nothing Then
        With objAppt
        .Subject = Subject
        .Body = Body
        .Start = Now + 1
        .End = DateAdd("h", 1, .Start)
        
        ' make it a meeting request
        .MeetingStatus = olMeeting
        .RequiredAttendees = "NFR Test Account"
        .Send
    End With
    
    Set objAppt = Nothing
    Set objOL = Nothing
    End If
    End If

If myCell.Value = "Priority 1" Then
myCell(1, 17).Value = "Meeting request sent"
myCell(1, 18).Value = Date
End If

Next myCell

End Sub
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Forum statistics

Threads
1,181,657
Messages
5,931,265
Members
436,785
Latest member
KingGideon

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top