Can someone help me integrate these two pieces of code? RRS feed

  • Question

  • We currently use a bit of code called "ReplyWithAttachments" because Outlook does not include attachments in a Reply All, and our Help Desk needs to include the original attachments on all our correspondence. So, we use this nifty "ReplyWithAttachments" code to do that.

    Unfortunately, we have found since going to Outlook 2010 that when sending mail from a 3rd party application (e.g., Remedy) our ReplyWithAttachments is not picking up the correct mailbox to send from. So, I'm wondering is if anyone coud help us incorporate Diane Pormesky's "using a specific account" code into our "ReplayWithAttahments" code? This would solve some problems for us, in that we could ensure  our "From" will always be the Help Desk address rather than our personal address. Here's the "ReplyWithAttachments" code:

    Sub ReplyWithAttachments()
    ' Keyboard Shortcut: Ctrl+w
    Dim rpl As Outlook.MailItem
    Dim itm As Object
    Set itm = GetCurrentItem()
    If Not itm Is Nothing Then
    Set rpl = itm.ReplyAll
    CopyAttachments itm, rpl
    End If
    Set rpl = Nothing
    Set itm = Nothing
    End Sub
    Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
    Set objApp = CreateObject("Outlook.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
    Case Else
    ' anything else will result in an error, which is
    ' why we have the error handler above
    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
    Set fldTemp = Nothing
    Set fso = Nothing
    End Sub

    And, here is Diane Pormesky's code...

    Public Sub New_Mail()  
    Dim oAccount As Outlook.Account  
    Dim oMail As Outlook.MailItem  
    For Each oAccount In Application.Session.Accounts  
       If oAccount = "Name_of_Default_Account" Then 
          Set oMail = Application.CreateItem(olMailItem)  
          oMail.SendUsingAccount = oAccount  
       End If 
    End Sub 

    Since I'm more of a code grabber than author (in fact, I couldn't author a single line!), if anyone could help me integrate these two code snippets it would be most helpful to our team. Once integrated I'll just replace the "Name_of_Default_Account" with our help desk mailbox name and we should be good to go.

    Thanks much!

    Dave Englund

    • Edited by dbe6347wf Monday, December 17, 2012 6:48 PM edit
    Monday, December 17, 2012 6:47 PM


All replies

  • objTargetItem.SendUsingAccount = objSourceItem.SendUsingAccount

    Dmitry Streblechenko (MVP)
    Redemption - what the Outlook
    Object Model should have been
    Version 5.4 is now available!

    Monday, December 17, 2012 6:54 PM
  • I have tried inserting the line "objTargetItem.SendUsingAccount = objSourceItem.SendUsingAccount" into my code under the "Sub CopyAttachments" section, but to no avail. Since I'm not a coder, is there any chance you might display the integrated code? :D  Thanks!

    Dave Englund

    Wednesday, January 2, 2013 6:53 PM
  • Actually the new item created by calling ReplyAll should inherit the account of the parent message.

    What happens if you add the folloiwng code immediately after the Set rpl = itm.ReplyAll line?

    Dim acct As Object

    set acct = rpl.SendUsingAccount

    if (acct Is Nothing) Then

      MsgBox "Account is not set"


      MsgBox "Account name is " & acct.DisplayName

    End If

    Dmitry Streblechenko (MVP)
    Redemption - what the Outlook
    Object Model should have been
    Version 5.4 is now available!

    Friday, January 4, 2013 7:25 PM
  • That gives me a message box: "Account name is <address>" and the address is my personal mailbox rather than the team shared mailbox. Now, if we could just set it to the team mailbox "Retirement Solution Center" :D

    Dave Englund

    Friday, January 4, 2013 9:12 PM
  • That is because the original message was received through your personal account, right?

    If you want a different account, you need to explicilty set it:

    rpl.SendUsingAccount = objApp.Session.Accounts.Item("<address of another account>")

    Dmitry Streblechenko (MVP)
    Redemption - what the Outlook
    Object Model should have been
    Version 5.4 is now available!

    Friday, January 4, 2013 10:12 PM