Distinguish between visible and invisible attachments Outlook (1 Viewer)

A

aman

Registered User.
Local time
Today, 06:41
Joined
Oct 16, 2008
Messages
1,250
The other thing I just realized is that if I try to convert '.txt' file into .pdf and save down on the network then it doesn't work with PropertyAccessor. Please see below the code. If I don't use PropertyAccessor class then text files get converted to pdf and get saved down but otherwise it just ignores text files:
Code: 
Private Sub SaveAttachments(olItem As Object)

Dim olAttach As Attachment
Dim strFName As String
Dim strExt As String
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItems As Outlook.Items
Dim j As Long
Dim olInsp As Inspector
Dim oRng As Object
Dim strTemp As String
Dim intPos As Integer

Dim olkPA As Object 'propertyAccessor
Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"

strTemp = Environ("TEMP") & ""

Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("Completed")
    
    If Not TypeName(olItem) = "MailItem" Then GoTo lbl_Exit
    
    CreateFolders strSaveFldr

    ' To save email message body as pdf
    
    SaveAsPDFfile olItem

    ' To save attachments as pdf.
       
    If olItem.Attachments.Count > 0 Then
        
        For j = 1 To olItem.Attachments.Count
                        
           Set olAttach = olItem.Attachments(j)
            
          
            ' New lines of code to exclude embedded attachments.
            
           ' Set olkPA = olAttach.PropertyAccessor
           ' If olkPA.GetProperty(PR_ATTACHMENT_HIDDEN) = False Then
            
            Select Case LCase(Mid(olAttach.FileName, InStrRev(olAttach.FileName, Chr(46))))
                
                Case ".docx", ".doc", ".dot", ".docm", ".dotm", ".txt"
                    On Error Resume Next
                    olAttach.SaveAsFile strTemp & olAttach.FileName
                    Set wdApp = GetObject(, "Word.Application")
                    If Err Then
                        Set wdApp = CreateObject("Word.Application")
                    End If
                    On Error GoTo 0
                    wdApp.Visible = True
                    Set wdDoc = wdApp.Documents.Open(strTemp & olAttach.FileName)
                    intPos = InStrRev(olAttach.FileName, ".")
                    strFName = Left(olAttach.FileName, intPos - 1)
                    strFName = strFName & ".pdf"
                    strExt = Right(strFName, Len(strFName) - InStrRev(strFName, Chr(46)))
                    strFName = FileNameUnique(strSaveFldr, strFName, strExt)
                    wdDoc.ExportAsFixedFormat OutputFilename:=strSaveFldr & strFName, _
                                              ExportFormat:=17, _
                                              OpenAfterExport:=False, _
                                              OptimizeFor:=0, _
                                              Range:=0, _
                                              From:=0, _
                                              To:=0, _
                                              Item:=0, _
                                              IncludeDocProps:=True, _
                                              KeepIRM:=True, _
                                              CreateBookmarks:=0, _
                                              DocStructureTags:=True, _
                                              BitmapMissingFonts:=True, _
                                              UseISO19005_1:=True
                    wdDoc.Close 0
                    wdApp.Quit
                    
                    'If bWordWasNotRunning = True Then wdApp.Quit
                Case ".pdf", ".jpg", ".jpeg"
                    
                    strFName = olAttach.FileName
                    strExt = Right(strFName, Len(strFName) - InStrRev(strFName, Chr(46)))
                    strFName = FileNameUnique(strSaveFldr, strFName, strExt)
                    olAttach.SaveAsFile strSaveFldr & strFName
                
                            
            End Select
     olItem.Categories = ""
     olItem.FlagStatus = olFlagComplete
     olItem.UnRead = False
     olItem.Save
        
       ' End If
        
        Next j
           
       ' olItem.Save
    
    End If
     
     olItem.Move myDestFolder
     Set olItem = myItems.FindNext
lbl_Exit:
    Set olAttach = Nothing
    Set olItem = Nothing
    Exit Sub
End Sub
 
S

sxschech

Registered User.
Local time
Today, 06:41
Joined
Mar 2, 2010
Messages
793
Another thought, if you can't get it to work, download the attachments and after that, in a separate step not part of the email loop, do the conversion?
You could csv concatenate the list of files during the loop and refer to that in a separate loop?

I didn't include this in my original post as this is used in another function. Here is some additional code for counting the number of attachments rather than the outlook total number of attachments for each email. This would replace "Mailobject.Attachments.Count"

Code: 
'--------------------------------------------------
'Determine if is "real" attachment, don't count
'embeded files as attachments as no need to save
'logos and signature graphic files
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
'--------------------------------------------------
 
A

aman

Registered User.
Local time
Today, 06:41
Joined
Oct 16, 2008
Messages
1,250
What about converting .txt files to pdf then ?
 
S

sxschech

Registered User.
Local time
Today, 06:41
Joined
Mar 2, 2010
Messages
793
Did you try the suggestion?

download the attachments and after that, in a separate step not part of the email loop, do the conversion
Click to expand...

That would mean simply run the code to save all the attachments (no case statments identifying file type). Once all the attachments have been downloaded then run a procedure to perform the conversion. In essence, move that part of the code to the end of your procedure or into its own procedure.

Another possibility if you want to try before moving that code out, is that maybe the text conversion to pdf takes more time to complete than other file types and the code is getting ahead of itself? Try to putting a break point at
Code: 
wdDoc.Close 0

Add this if statement above the Close statement and put the breakpoint on the debug.print line, that way it won't stop for other document types since you said the others come out fine.
Code: 
If LCase(Mid(olAttach.FileName, InStrRev(olAttach.FileName, Chr(46))))=".txt" Then
debug.print LCase(Mid(olAttach.FileName, InStrRev(olAttach.FileName, Chr(46))))
End If
give it a moment and check if the text conversion pdf file is there. If the file is created after being given more time, then you would need to figure out how to give the program time to complete before closing and moving to the next item.

The above may not work, but I encountered a situation like that on another user's computer where the code ran faster than on mine and things that were supposed to be created weren't and turned out was due to code continuing before the other process completed. I didn't know how to get the program to wait until that part finished since I tried Do Events and that didn't help, so ended up putting a message box, which of course means that user interaction is required by clicking the OK button, not ideal, but in the short run allowed the code to complete properly.
 
A

aman

Registered User.
Local time
Today, 06:41
Joined
Oct 16, 2008
Messages
1,250
June7 said:
The logos/signatures are jpg/jpeg format?

Is this procedure in Outlook?
Click to expand...

Yes the procedure is in outlook and if I remove ".jpg" and ".jpeg" from my select case statement then it automatically excludes embedded attachments as below. It is as simple as that so why do we need to use Property Accessor class ?

Code: 
Private Sub SaveAttachments(olItem As Object)

Dim olAttach As Attachment
Dim strFName As String
Dim strExt As String
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItems As Outlook.Items
Dim j As Long
Dim olInsp As Inspector
Dim oRng As Object
Dim strTemp As String
Dim intPos As Integer

Dim olkPA As Object 'propertyAccessor
Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"

strTemp = Environ("TEMP") & "\"

Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("Completed")
    
    If Not TypeName(olItem) = "MailItem" Then GoTo lbl_Exit
    
    CreateFolders strSaveFldr

    ' To save email message body as pdf
    
    SaveAsPDFfile olItem

    ' To save attachments as pdf.
       
    If olItem.Attachments.Count > 0 Then
        
        For j = 1 To olItem.Attachments.Count
                        
           Set olAttach = olItem.Attachments(j)
            
          
            ' New lines of code to exclude embedded attachments.
            
           ' Set olkPA = olAttach.PropertyAccessor
           ' If olkPA.GetProperty(PR_ATTACHMENT_HIDDEN) = False Then
            
            Select Case LCase(Mid(olAttach.FileName, InStrRev(olAttach.FileName, Chr(46))))
                
                Case ".docx", ".doc", ".dot", ".docm", ".dotm", ".txt"
                    On Error Resume Next
                    olAttach.SaveAsFile strTemp & olAttach.FileName
                    Set wdApp = GetObject(, "Word.Application")
                    If Err Then
                        Set wdApp = CreateObject("Word.Application")
                    End If
                    On Error GoTo 0
                    wdApp.Visible = True
                    Set wdDoc = wdApp.Documents.Open(strTemp & olAttach.FileName)
                    intPos = InStrRev(olAttach.FileName, ".")
                    strFName = Left(olAttach.FileName, intPos - 1)
                    strFName = strFName & ".pdf"
                    strExt = Right(strFName, Len(strFName) - InStrRev(strFName, Chr(46)))
                    strFName = FileNameUnique(strSaveFldr, strFName, strExt)
                    wdDoc.ExportAsFixedFormat OutputFilename:=strSaveFldr & strFName, _
                                              ExportFormat:=17, _
                                              OpenAfterExport:=False, _
                                              OptimizeFor:=0, _
                                              Range:=0, _
                                              From:=0, _
                                              To:=0, _
                                              Item:=0, _
                                              IncludeDocProps:=True, _
                                              KeepIRM:=True, _
                                              CreateBookmarks:=0, _
                                              DocStructureTags:=True, _
                                              BitmapMissingFonts:=True, _
                                              UseISO19005_1:=True

                    wdDoc.Close 0
                    wdApp.Quit
                    
                    'If bWordWasNotRunning = True Then wdApp.Quit
                Case ".pdf"
                    
                    strFName = olAttach.FileName
                    strExt = Right(strFName, Len(strFName) - InStrRev(strFName, Chr(46)))
                    strFName = FileNameUnique(strSaveFldr, strFName, strExt)
                    olAttach.SaveAsFile strSaveFldr & strFName
                
                            
            End Select
     olItem.Categories = ""
     olItem.FlagStatus = olFlagComplete
     olItem.UnRead = False
     olItem.Save
        
      '  End If
        
        Next j
     
     End If
     
     olItem.Move myDestFolder
     Set olItem = myItems.FindNext
     
lbl_Exit:
    Set olAttach = Nothing
    Set olItem = Nothing
    Exit Sub
End Sub
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 14:41
Joined
Sep 21, 2011
Messages
14,320
So what would happen if you were sent a jpeg or jpg file as a proper attachment?
 
S

sxschech

Registered User.
Local time
Today, 06:41
Joined
Mar 2, 2010
Messages
793
I didn't realize that you were trying this code directly in outlook. I am running it from an Access Code module.

I agree with Gasman's question, which is why I ended up using the Property Accessor code. Of course, if you are sure that you won't be receiving jpg, jpeg, then maybe you could get by without it, but then it would still download other embedded file types that you aren't trapping for.
 
You must log in or register to reply here.

Similar threads

M
Multiple attachments and a report in the same email
Replies
15
Views
964
Marshall Brooks
M
G
Invalid procedure call or argument brows and attach file
2
Replies
23
Views
1,805
Minty
Minty
R
Access DB attachments form and VBA
Replies
19
Views
1,377
Pat Hartman
P
M
Solved Run Time Error while attaching the PDF to the Email
Replies
13
Views
1,529
mrk777
M
L
Solved loop thru continuous form and add attachments to outlook message
Replies
8
Views
981
bastanu
bastanu

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom