Two Outlook Questions on email from Access VBA (ReplyAll, Attachments)

[sxschech]

Hope I can ask two-in-one (these are separate issues, both relate to Outlook though).

1) How to ReplyAll or Forward:

Cobbled together some code to perform a ReplyAll or forward an email. I was able to get the code to locate the message and display - as want to see how it looks rather than blindly sending it, after looking more closely turns out what is happening is outlook is adding new content to the existing message rather than creating the ReplyAll. I am missing a a command or a few commands, but have not seen anything more while searching, obviously I have hit a "blind spot" due to lack of outlook vba knowledge.

Public Sub Outlook_ReplyAll(subj As String)
'Reply to All from current message
'[URL unfurl="true"]http://www.vbaexpress.com/forum/showthread.php?56727-How-To-Reply-To-Most-Recent-E-mail-for-a-Specific-Subject[/URL]
'20180920
'------------------------
'Needs to be fixed so that replies to all, currently seems to only be able to
'display the existing message then have to manually click the reply to all
'button in outlook
'20180920
'------------------------
    Dim olAPP As Object                 'Late
    Dim Inbox As Object
    Dim InboxItems As Object
    Dim InboxAttachment As Object
    Dim Mailobject As Object
    Dim InboxReply As Object
    Dim SubjectFilter As String
    Dim stBody As String
    
    On Error Resume Next
    Set olAPP = GetObject(, "Outlook.Application")      'Outlook Running
    If Err.Number <> 0 Then
        Err.Clear
        Set olAPP = CreateObject("Outlook.Application") 'Outlook Not Running
    End If
    
    'Doc Inbox
    Set Inbox = olAPP.GetNamespace("Mapi").folders("Doc").folders("Inbox") 'Inbox")
    
    Set InboxItems = Inbox.Items
    'Set InboxAttachment = Mailobject.Attachment
    
    SubjectFilter = (subj)  '("Fwd: How to write code") ' THIS IS WHERE YOU PLACE THE EMAIL SUBJECT FOR THE CODE TO FIND
    stBody = "The answer to this question requires thought, if any ideas were missed, please let me know. " & _
             "<br><br>Thanks,<br>"
    If Not Inbox Is Nothing Then
        For Each Mailobject In InboxItems
            If InStr(1, Mailobject.Subject, SubjectFilter) > 0 Then
                With Mailobject
                    .replyall
                    .htmlbody = stBody & "<br>" & .htmlbody
                    .display
                End With
            End If
        Next
    End If
            
Finished:
    Set olAPP = Nothing
    Set Inbox = Nothing
    Set InboxItems = Nothing
    Set Mailobject = Nothing
End Sub

2) How to identify emails with attachments that have a paperclip icon rather than all emails with attachments.

I have been using code that identifies attachments

Mailobject.Attachments.Count

, seems to include/consider embeded attachments such as company logos as attachments. I noticed when I look in the outlook inbox, the emails that I want to identify as having attachments have a paperclip icon, so somehow would like to do something like "has paperclip". The code I am running does not automatically download attachments as I only want to download attachments as needed. I have a form that has a button indicator that looks in the table of outlook data and if that table indicates an attachment, I can click on it to download the attachments, however I don't want to waste time downloading if it says the email has attachments, but it turns out it is a company logo. Some suggestions I found on the web said to add an If statement to exclude files ending in png and gif, but what if there is a legitimate attachment with that extension? Hence, seemed the easy solution in theory is the paperclip icon indicator.

 

[sxschech]

One down (Fixed Reply issue), one to go (attachment issue). Reread the link and found in post #2, should have used Set, rather than simply reply. Have modified the code accordingly and expanded to allow user to choose whether message is to be Reply, ReplyAll or Forward. Modifications in red and green

Public Sub Outlook_ReplyAll(subj As String[COLOR=#EF2929], SendType As String[/color])
'Reply to All from current message
'[URL unfurl="true"]http://www.vbaexpress.com/forum/showthread.php?56727-How-To-Reply-To-Most-Recent-E-mail-for-a-Specific-Subject[/URL]
'20180920
'------------------------
'Needs to be fixed so that replies to all, currently seems to only be able to
'display the existing message then have to manually click the reply to all
'button in outlook
'20180920
'Fixed by reviewing link and saw in post #2 that needed to use the SET statement
'rather than simply using .replyall
'added functionality to create message based on Reply, ReplyAll and Forward
'20181008
'------------------------
'------------------------
    Dim olAPP As Object                 'Late
    Dim Inbox As Object
    Dim InboxItems As Object
    Dim InboxAttachment As Object
    Dim Mailobject As Object
    Dim InboxReply As Object
    Dim SubjectFilter As String
    Dim stBody As String
    
    On Error Resume Next
    Set olAPP = GetObject(, "Outlook.Application")      'Outlook Running
    If Err.Number <> 0 Then
        Err.Clear
        Set olAPP = CreateObject("Outlook.Application") 'Outlook Not Running
    End If
    
    'Doc Inbox
    Set Inbox = olAPP.GetNamespace("Mapi").folders("Doc").folders("Inbox") 'Inbox")
    
    Set InboxItems = Inbox.Items
    'Set InboxAttachment = Mailobject.Attachment
    
    SubjectFilter = (subj)  '("Fwd: How to write code") ' THIS IS WHERE YOU PLACE THE EMAIL SUBJECT FOR THE CODE TO FIND
    stBody = "The answer to this question requires thought, if any ideas were missed, please let me know. " & _
             "<br><br>Thanks,<br>"
    If Not Inbox Is Nothing Then
        For Each Mailobject In InboxItems
            If InStr(1, Mailobject.Subject, SubjectFilter) > 0 Then
                [COLOR=#EF2929][COLOR=#EF2929][/color]Select Case SendType
                Case "Reply"
                    Set InboxReply = Mailobject.reply
                Case "Reply All"
                    Set InboxReply = Mailobject.replyall
                Case "Forward"
                    Set InboxReply = Mailobject.Forward
                End Select[/color]
                With Mailobject
                    '[COLOR=#4E9A06][s].replyall[/s][/color]
                    .htmlbody = stBody & "<br>" & .htmlbody
                    .display
                End With
            End If
        Next
    End If
            
Finished:
    Set olAPP = Nothing
    Set Inbox = Nothing
    Set InboxItems = Nothing
    Set Mailobject = Nothing
End Sub

 

[sxschech]

After more searching I found some code that seems to work so far. I say so far because the poster said

There is a PR_ATTACHMENT_HIDDEN property that could be used, but it brings its own problems.

, but did not elaborate on what those problems may be.

http://www.vbaexpress.com/forum/showthread.php?58494-Outlook-Attachments

In my code, I replaced

Mailobject.Attachments.Count

With

For Each InboxAttachment In Mailobject.Attachments
	Set olkPA = InboxAttachment.propertyAccessor
	If olkPA.GetProperty(PR_ATTACHMENT_HIDDEN) = False Then
	intAttachmentCount = intAttachmentCount + 1
	End If
	Set InboxAttachment = Nothing
Next