• This site uses cookies. By continuing to use this site, you are agreeing to our use of cookies. Learn more.

Help Please!!! Outlook 2016 - VBA Macro for replying with attachment in meeting invite

JaCrispy

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#1
Hello,

So I have VBA code to reply to a normal email with attachment, but I need help to modify the code below so that it can also work when you reply from a meeting invitation using email to include the attachments that are included in that meeting invite. If you use the "forward" option from a meeting invite, it forwards the actual meeting invitation, which is not what I would like to do. I would like to reply to the meeting invite and include the attachments.

Code:
Sub ReplyWithAttachments()
    Dim rpl As Outlook.MailItem
    Dim itm As Object
    
    Set itm = GetCurrentItem()
    If Not itm Is Nothing Then
        Set rpl = itm.Reply
        CopyAttachments itm, rpl
        rpl.Display
    End If
    
    Set rpl = Nothing
    Set itm = Nothing
End Sub

Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
        
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
    
    Set objApp = Nothing
End Function

Sub CopyAttachments(objSourceItem, objTargetItem)
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
   strPath = fldTemp.Path & "\"
   For Each objAtt In objSourceItem.Attachments
      strFile = strPath & objAtt.FileName
      objAtt.SaveAsFile strFile
      objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
      fso.DeleteFile strFile
   Next

   Set fldTemp = Nothing
   Set fso = Nothing
End Sub
Thanks!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#2
Because you don't reply to meetings, Set rpl = itm.Reply won't work. I think you'll need to create a new message - there is a send mail to attendees command but i don't know if it is exposed in the object model. (will look later)

Code:
Set replyMeeting = Application.CreateItem(olMailItem)
  replyMeeting.Body = item.body
  replyMeeting.Subject = "Re: " & item.subject
  replyMeeting.To = item.organizer ' not sure if this is right
  replyMeeting.Display ' use .send to send
if you want to reply to all attendees, see Send an email to attendees who have not responded (it can be tweaked to reply to all)
 

JaCrispy

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#3
Hello,

Thanks for your tip. I have tried implementing it, but it's not working so far :\
 

JaCrispy

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#4
Hello,

Thanks for your tip. I have tried implementing it, but it's not working so far :\
Actually.. I did get it working, but the format of the body of the invitation gets stripped out and any pictures etc are missing. any ideas?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#9
Baby steps...

This works (you need the functions from your macro) - but you need to select all and copy the appt body to the clipboard before running the macro. :(

Code:
Sub ConvertSelectionToAppointment()
' You need the GetCurrentItem Function from
'http://slipstick.me/e8mio

    Dim objMail   As Outlook.AppointmentItem
    Dim objAppt As Outlook.MailItem
  
    ' Add reference to Word library
    ' in VBA Editor, Tools, References
    Dim objInsp As Inspector
    Dim objDoc As Word.Document
    Dim objSel As Word.Selection

    Set objMail = GetCurrentItem()
      
    On Error Resume Next
 
  If Not objMail Is Nothing Then
            Set objInsp = objMail.GetInspector
                Set objDoc = objInsp.WordEditor
                Set objWord = objDoc.Application
                Set objSel = objWord.Selection
        With objSel
           'use wholestory to copy the entire message body
 ''            .WholeStory
  '           .Copy
       End With
 
    End If
    

Set replyMeeting = Application.CreateItem(olMailItem)
    Set objInsp = replyMeeting.GetInspector
    Set objDoc = objInsp.WordEditor
    Set objSel = objDoc.Windows(1).Selection


CopyAttachments objMail, replyMeeting
    objSel.PasteAndFormat (wdFormatOriginalFormatting)

    objSel.Range.InsertParagraphBefore
    objSel.Range.InsertParagraphBefore
 
  replyMeeting.Subject = "Re: " & objMail.Subject
  replyMeeting.To = objMail.Organizer ' not sure if this is right
  replyMeeting.Display ' use .send to send
    
    objMail.Categories = "Appt" & objMail.Categories
    Set objAppt = Nothing
    Set objMail = Nothing
End Sub
 

Similar threads