Outlook VBA script

I created a rule that will triggered the following code, when I get an new email. The issue is the script executes on the current email instead of the new email which triggered the rule. Please help.

 
Option Explicit


Sub NewMeetingRequestFromEmail(item As Outlook.MailItem)
    Dim app As New Outlook.Application
   
    
    If app.ActiveInspector Is Nothing Then
        If app.ActiveExplorer.IsPaneVisible(olPreview) Then
            Set item = app.ActiveExplorer.Selection.item(1)
        End If
    Else
        Set item = app.ActiveInspector.CurrentItem
    End If
    
    If item Is Nothing Then Exit Sub
    
    If item.Class <> olMail Then Exit Sub
    
    Dim email As MailItem
    
    Set email = item
    
    Dim meetingRequest As AppointmentItem
    
    Set meetingRequest = app.CreateItem(olAppointmentItem)
    
    meetingRequest.Categories = email.Categories
    meetingRequest.Body = email.Body
    meetingRequest.Subject = email.Subject
    meetingRequest.Location = email.Subject
    meetingRequest.Start = DateSerial(Year(Now), Month(Now), Day(Now) + 1) + #10:00:00 AM#
    meetingRequest.Duration = 60
    meetingRequest.ReminderMinutesBeforeStart = 45
    meetingRequest.ReminderSet = True

    Dim attachment As attachment
    For Each attachment In email.Attachments
        CopyAttachment attachment, meetingRequest.Attachments
    Next attachment
    
    Dim recipient As recipient
    
    Set recipient = meetingRequest.Recipients.Add(email.SenderEmailAddress)
    recipient.Resolve
    
    For Each recipient In email.Recipients
        RecipientToParticipant recipient, meetingRequest.Recipients
    Next recipient
    
    Dim inspector As inspector
    
    Set inspector = meetingRequest.GetInspector
        
    'inspector.CommandBars.FindControl
    inspector.Display
    meetingRequest.Save
    
End Sub

Private Sub RecipientToParticipant(recipient As recipient, participants As Recipients)
    Dim participant As recipient
    
    If LCase(recipient.Address) <> LCase(Session.CurrentUser.Address) Then
        Set participant = participants.Add(recipient.Address)
        Select Case recipient.Type
        Case olBCC:
            participant.Type = olOptional
        Case olCC:
            participant.Type = olOptional
        Case olOriginator:
            participant.Type = olRequired
        Case olTo:
            participant.Type = olRequired
        End Select
        participant.Resolve
    End If

End Sub

Private Sub CopyAttachment(source As attachment, destination As Attachments)
    On Error GoTo HandleError
    
    Dim filename As String
    
    filename = Environ("temp") & "\" & source.filename
    
    source.SaveAsFile (filename)
    
    destination.Add (filename)
    
    Exit Sub
    
HandleError:
    Debug.Print Err.Description
End Sub

Open in new window

karthik80cAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
HI,

in NewMeetingRequestFromEmail you get item As Outlook.MailItem then you redefine it that's maybe the problem

and why do you have to define app as Dim app As New Outlook.Application

Regards
0
karthik80cAuthor Commented:
Sub NewMeetingRequestFromEmail(Email As MailItem)
   
    Dim app As New Outlook.Application
   
    
    Dim dtInspDate As String
    Dim dtInspTime As String
    Dim itemBody As String

Dim aText As Variant, aTextTmp As Variant, aInspDate As Variant
itemBody = Email.body
            
aText = Split(itemBody, vbCrLf)
aTextTmp = Filter(aText, "Inspection Date:")
aInspDate = Split(aTextTmp(0), ": ")
dtInspDate = DateValue(aInspDate(1))
dtInspTime = TimeValue(aInspDate(1))
    

    Dim meetingRequest As AppointmentItem
    
    Set meetingRequest = app.CreateItem(olAppointmentItem)
    
    meetingRequest.Categories = Email.Categories
    meetingRequest.body = Email.body
    meetingRequest.Subject = Email.Subject
    meetingRequest.Location = Email.Subject
    meetingRequest.Start = dtInspDate + #11:00:00 AM#
    meetingRequest.Duration = 60
    meetingRequest.ReminderMinutesBeforeStart = 45
    meetingRequest.ReminderSet = True

    Dim attachment As attachment
    For Each attachment In Email.Attachments
        CopyAttachment attachment, meetingRequest.Attachments
    Next attachment
    
    Dim recipient As recipient
    
    Set recipient = meetingRequest.Recipients.Add(Email.SenderEmailAddress)
    recipient.Resolve
    
    For Each recipient In Email.Recipients
        RecipientToParticipant recipient, meetingRequest.Recipients
    Next recipient
    
    Dim inspector As inspector
    
    Set inspector = meetingRequest.GetInspector
        
    'inspector.CommandBars.FindControl
    inspector.Display
    meetingRequest.Save
    
End Sub

Private Sub RecipientToParticipant(recipient As recipient, participants As Recipients)
    Dim participant As recipient
    
    If LCase(recipient.address) <> LCase(Session.CurrentUser.address) Then
        Set participant = participants.Add(recipient.address)
        Select Case recipient.Type
        Case olBCC:
            participant.Type = olOptional
        Case olCC:
            participant.Type = olOptional
        Case olOriginator:
            participant.Type = olRequired
        Case olTo:
            participant.Type = olRequired
        End Select
        participant.Resolve
    End If

End Sub

Private Sub CopyAttachment(source As attachment, destination As Attachments)
    On Error GoTo HandleError
    
    Dim filename As String
    
    filename = Environ("temp") & "\" & source.filename
    
    source.SaveAsFile (filename)
    
    destination.Add (filename)
    
    Exit Sub
    
HandleError:
    Debug.Print Err.Description
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
karthik80cAuthor Commented:
I have corrected the script on my own and it works. Thank you!!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.