Solved

Outlook VBA reply all with GLOBAL unresolved emails

Posted on 2013-02-04
13
1,189 Views
Last Modified: 2013-02-18
Hi,

I have an outlook (2003 or 2010) VBA function that I am working on is one that reads the selected email, replies to all, and populates the CC list with everyone that was either in the to or cc list.  The problem that I've run into is that for some of the folks who are in our global address book other than lastname, first, I get a relative address not the actual email address in the cc box.  What I would like is to just get the email address.


Here is the macro to reply:

Sub ERCCommReply()
    On Error GoTo ErrorHandler
    Dim olkMsg As Outlook.MailItem, olkMsg2 As Outlook.MailItem, olkRpl As Outlook.MailItem, olkRcp As Outlook.Recipient, olkAdd As Outlook.Recipient, intIndex As Integer
   
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            'Set olkMsg = Application.ActiveExplorer.Selection(1)
            Set olkMsg = Application.ActiveExplorer.Selection.Item(1)
            'Set olkMsg2 = Application.ActiveExplorer.Selection.Item(1)
            Set olkRpl = Application.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set olkMsg = Application.ActiveInspector.CurrentItem
            'Set olkMsg2 = Application.ActiveInspector.CurrentItem
            Set olkRpl = Application.ActiveInspector.CurrentItem
    End Select
   
   

   
    Set olkRpl = olkMsg.ReplyAll
   
    If ActiveExplorer.Selection.Count > 1 Then
        MsgBox "To ensure proper processing" & vbCrLf & "please select one email only.", , "Too many emails selected!"
        GoTo ProgramExit
    End If
   
   
       
   
    Dim Signature As String
    If Dir(MySig) <> "" Then
        Signature = GetBoiler(MySig)
    Else
        Signature = ""
    End If
   
    olkRpl.BodyFormat = olFormatHTML
     
   
    olkRpl.HTMLBody = olkMsg.HTMLBody
   
    For intIndex = olkRpl.Recipients.Count To 1 Step -1
        olkRpl.Recipients.Item(intIndex).Delete
    Next
   
    olkRpl.CC = ERCComm
   
    Set olkRcp = olkRpl.Recipients.Add(olkMsg.SenderEmailAddress)
    olkRcp.Type = olTo
    For Each olkAdd In olkMsg.Recipients
   


        If olkAdd.Name <> Session.CurrentUser And InStr(ERCCommNames, olkAdd.Name) = 0 Then
        'If olkAdd.Name <> Session.CurrentUser And InStr(ERCCommNames, olkAdd.Name) = 0 _
           And InStr(ERCComm, olkAdd.Address) = 0 Then
            Set olkRcp = olkRpl.Recipients.Add(olkAdd.Address)
            Select Case olkAdd.Type
                Case olOriginator
                    olkRcp.Type = olTo
                Case Else
                    olkRcp.Type = olCC
            End Select
        End If
    Next
   
   
          'MsgBox olkRpl.CC & " to:" & olkRpl.To
     
          MyInput2 = InputBox("If there is an CASE Number associated with this message, provide it below (number only)", "CASE Number?")
   
        MsgBox "made it here"
     
            subject = ""
               
            'Append the require info to the subject line
            'If the For official Use Only is in the subject line, do not add it again.
            'If InStr(UCase(olkMsg.subject), ERSubjectLine) Then
            If InStr(UCase(olkRpl.subject), ERSubjectLine) Then
            Else
                'subject = ERSubjectLine & " - " & olkMsg.subject
                subject = ERSubjectLine & " - " & olkRpl.subject
            End If
           
            If InStr(UCase(olkRpl.subject), MyInput2) Or MyInput2 = "" Then
            'If InStr(UCase(Msg.Forward.subject), MyInput2) Or MyInput2 = "" Then
            'If InStr(UCase(Msg.Forward.subject), MyInput2) Then
            Else
                subject = "CASE-" & MyInput2 & ": " & subject
            End If
           
   
    If olkMsg.Attachments.Count > 0 Then
        Dim result
                   
        result = MsgBox("Do you want to include the current attachments?", vbYesNo + vbQuestion)
        If result = vbYes Then
            CopyAttachments olkMsg, olkRpl
        End If
                   
    End If
           
    olkRpl.BodyFormat = olFormatHTML

    olkRpl.Recipients.ResolveAll
   
    olkRpl.HTMLBody = olkMsg.Forward.HTMLBody
   
    olkRpl.subject = subject
   
    olkRpl.Display
   
    Set olkMsg = Nothing
    Set olkMsg2 = Nothing
    Set olkRpl = Nothing
    Set olkRcp = Nothing
    Set olkAdd = Nothing
ProgramExit:
    Exit Sub
ErrorHandler:

    If Err.Number = "-2147352567" Then
        MsgBox "You must select/hightlight/set the focus on a message " & vbCrLf & "from the list (e.g., Inbox) before clicking this button." & vbCrLf & vbCrLf & _
        "If you are currently looking at an open message, " & vbCrLf & _
        "you will continue to recieve this message.", vbOKOnly, "Select a message from the list."
    Else
        MsgBox Err.Number & " - " & Err.Description
    End If
   
    Resume ProgramExit
   
End Sub
0
Comment
Question by:atljarman
  • 7
  • 6
13 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 38862660
Hi, atljarman.

I'm not clear on what you mean when you say "... I get a relative address not the actual email address".  What does relative address mean?
0
 

Author Comment

by:atljarman
ID: 38863153
I get a relative reference like "/O=MDA/OU=First Administrative Group/cn=Recipients/cn=BobCates;" from the global address book.

It's like it knows the relative reference to the contact information in the global address book but rather than pull the actual email address it pulls the relative reference.  When in all other instances when the name is listed as last, first, then the email address actually populates.

The email in outlook, using the example above might look like: Arizona-Cates, Bob and the underlying email address in the original email (when double clicking on the name from the original email) is bcates@arizona.gov.  So my question is, when using this macro, why does Outlook pull "/O=MDA/OU=First Administrative Group/cn=Recipients/cn=BobCates;"
instead of bcates@arizona.gov in these instances, or how to ensure that the actually email address is grabbed not this relative reference.
0
 
LVL 76

Assisted Solution

by:David Lee
David Lee earned 500 total points
ID: 38863389
That's not a relative reference.  It's an X500 address which is what Exchange uses internally.  You want the SMTP address.  There's a solution for that in Outlook 2010, but that solution won't work in Outlook 2003.  Here's the code for getting the SMTP address in Outlook 2010.  To use this, simply call the function GetSMTPAddress and pass it the original mail item.

Function GetSMTPAddress(Item As Outlook.MailItem)
    Dim olkSnd As Object, olkEnt As Object
    Set olkSnd = Item.Sender
    If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then
        Set olkEnt = olkSnd.GetExchangeUser
        GetSMTPAddress = olkEnt.PrimarySmtpAddress
    Else
        GetSMTPAddress = Item.SenderEmailAddress
    End If
End Function

Open in new window


There is a way to do the same thing in Outlook 2003 using CDO or the Outlook Redemption library.  Or you could use Redemption do it in Outlook 2003 and 2010.  I don't have a copy of Outlook 2003 loaded anymore and therefore can't provide code for that version using CDO.
0
 

Author Comment

by:atljarman
ID: 38863525
Is there a way to detect if the user is using 2003 to prevent the function from firing?
0
 
LVL 76

Assisted Solution

by:David Lee
David Lee earned 500 total points
ID: 38863536
Sure.  Add this code to what you already have.

Function GetOutlookVersion() As Integer
    Dim arrVer As Variant
    arrVer = Split(Outlook.Version, ".")
    GetOutlookVersion = arrVer(0)
End Function

Open in new window


To use it

If GetOutlookVersion() >= 14 then
    strAddr = GetSMTPAddress()
Else
    'Code for whatever you want to do if this is Outlook 2007 or earlier.
End If

Open in new window

0
 

Author Comment

by:atljarman
ID: 38863765
I will give this a try later today.  I am going to post a new question shortly in looking at pulling names from a distribution list.  I have another function that checks to see if the person was already copied on the email then if they were, then don't add them.  If they were not, then look add the remaining names/emails from the distribution list.
0
Control application downtime with dependency maps

Visualize the interdependencies between application components better with Applications Manager's automated application discovery and dependency mapping feature. Resolve performance issues faster by quickly isolating problematic components.

 
LVL 76

Expert Comment

by:David Lee
ID: 38863877
Ok.  If you post a link to that question here, then I'll take a look.
0
 

Author Comment

by:atljarman
ID: 38864088
This is what I've modified in the code:

            If GetOutlookVersion() >= 14 Then
                Set olkRcp = olkRpl.Recipients.Add(GetSMTPAddress(olkAdd.Address))
            Else
                Set olkRcp = olkRpl.Recipients.Add(olkAdd.Address)
            End If

Open in new window



Compile Error: Type Mismatch highligting olkAdd.Address of the GetSMTPAddress function.  I think that there could be another definition like olkAdd.Address.email or something, but not sure what.  Any thoughts.
0
 

Author Comment

by:atljarman
ID: 38864192
Ok... I've tried a couple of things.


            If GetOutlookVersion() >= 14 Then
                Set olkRcp = olkRpl.Recipients.Add(GetSMTPAddress(olkMsg))
            Else
                Set olkRcp = olkRpl.Recipients.Add(olkAdd.Address)
            End If

is the only thing that seems to not get the type mismatch but inserts the sender the same number of times that ther are receipients in the original email.  It's kind of funny, but not helpful.

Is there a way to modify the function so it will just loop through the olkRpl.Recipients? or use the OlkAdd.Address (e.g., String vs oulook item)
0
 
LVL 76

Expert Comment

by:David Lee
ID: 38866513
Could you post your code as you have it now so I can take a look?  If so, please embed it in the code tags using the code button on the toolbar above.  That makes the code much easier to read.
0
 

Accepted Solution

by:
atljarman earned 0 total points
ID: 38880111
This is actually what worked (replacing the For Each section of the original code).


    For Each olkAdd In olkMsg.Recipients
   
        If olkAdd.Name <> Session.CurrentUser And InStr(ERCCommNames, olkAdd.Name) = 0 Then
       
            If GetOutlookVersion() >= 14 Then

                If olkAdd.AddressEntry.DisplayType = 0 Then
                    Set olkRcp = olkRpl.Recipients.Add(olkAdd.Address)
                ElseIf olkAdd.AddressEntry.DisplayType = 1 Then
                    Set olkRcp = olkRpl.Recipients.Add(olkAdd.Address)
                ElseIf olkAdd.AddressEntry.DisplayType = 6 Then
                    Set olkRcp = olkRpl.Recipients.Add(olkAdd.AddressEntry.GetExchangeUser.PrimarySmtpAddress)
                End If

            Else
                Set olkRcp = olkRpl.Recipients.Add(olkAdd.Address)
            End If
           
           
           
            Select Case olkAdd.Type
                Case olOriginator
                    olkRcp.Type = olTo
                Case Else
                    olkRcp.Type = olCC
            End Select
        End If
    Next
0
 

Author Closing Comment

by:atljarman
ID: 38898152
Thanks for your help.  I took your suggestion and had to work it around to get the actual code to work.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 38902748
You're welcome!
0

Featured Post

Zoho SalesIQ

Hassle-free live chat software re-imagined for business growth. 2 users, always free.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Sometimes Outlook might have problems sending a message. There may be various causes- corrupted PST, AV scanner etc. The message, instead of going to the Sent Items folder, sits in the Outbox indefinitely. To remove it you can use a free tool cal…
Computer science students often experience many of the same frustrations when going through their engineering courses. This article presents seven tips I found useful when completing a bachelors and masters degree in computing which I believe may he…
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

895 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now