Opening Outlook Attachments Redux

In Opening Outlook Attachments, I posted some code to open Outlook attachments using the keyboard. Now that I’m back using Outlook, I had to dig out the old code and put it to use. Of course I won’t be leaving well enough alone, but thanks for asking.

The last change I made was to refactor a lot of the code into separate procedures. When my procedure is bigger than one code pane, it’s time to refactor.

I was perfectly happy getting the last attachment on the list. If I had more than one attachment, I would resort to the mouse. I thought I could do better. I change the code so that successive calls opened each attachment in order. A static variable keeps my place. That meant that I needed to get a collection of valid attachments. I couldn’t just grab the last attachment that wasn’t hidden, I need to get them all. Here’s the main procedure:

Public Sub OpenAttachment()

Dim miItem As MailItem
Dim sFileName As String
Dim sPath As String
Dim olAtt As Attachment
Dim colValidAtts As Collection

Static lAtt As Long

sPath = VBA.Environ$("Tmp") & "\"
Set miItem = GetCurrentItem

If Not miItem Is Nothing Then
Set colValidAtts = GetValidAttachments(miItem)

If colValidAtts.Count > 0 Then
lAtt = CycleAttachments(lAtt, colValidAtts.Count)
Set olAtt = colValidAtts.Item(lAtt)

sFileName = olAtt.FileName
'delete just in case it exists from before
On Error Resume Next
Kill sPath & sFileName

If Err.Number <> 70 Then
On Error GoTo 0

olAtt.SaveAsFile sPath & sFileName
DisplayAttachment olAtt, sFileName, sPath
End If
End If
End If

End Sub

In English: Get the path to the Temp folder, get the current item (either open email or selected in a folder), collect the valid attachments, pick the next in the cycle, display it. Getting the current item didn’t change from the last version, it’s just in it’s own procedure now.

Public Function GetCurrentItem() As MailItem

Dim miReturn As MailItem

On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set miReturn = ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set miReturn = ActiveInspector.currentItem
End Select
On Error GoTo 0

Set GetCurrentItem = miReturn

End Function

Next, I collect the valid attachments. I have to check some MAPI property. I don’t understand MAPI properties fully, but I don’t need to to be able to copy stuff from the web. The error trapping is because this property isn’t True or False, rather it exists or it doesn’t.

Public Function GetValidAttachments(miItem As MailItem) As Collection

Dim colReturn As Collection
Dim olAtt As Attachment

Set colReturn = New Collection

For Each olAtt In miItem.Attachments
If Not AttIsHidden(olAtt) Then
colReturn.Add olAtt
End If
Next olAtt

Set GetValidAttachments = colReturn

End Function

Public Function AttIsHidden(olAtt As Attachment) As Boolean

On Error Resume Next
AttIsHidden = olAtt.propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x7FFE000B")
On Error GoTo 0

End Function

Once I have a collection of attachments, I pick the next one based on the value of lAtt (the static variable). It’s a reverse order progression, so if lAtt is 0 or 1, it picks the last attachments. Otherwise it decrements lAtt.

Public Function CycleAttachments(ByVal lAtt As Long, ByVal lCount As Long) As Long

Dim lReturn As Long

If lAtt <= 1 Or lAtt > lCount Then
lReturn = lCount
Else
lReturn = lAtt - 1
End If

CycleAttachments = lReturn

End Function

Another minor change I made was to check for Error 70 – permission denied. That means I already opened that attachment and it’s still opened. Finally, I display the attachment. This is where things get very imcompletish. Some people send me other emails as attachments. That’s a whole other ball game, so I have to check if the Attachment.Type is olEmbeddedItem. If it is, I display the item. If it’s embedded but not a MailItem, the whole thing blows up. There can be other types of embedded items. I might be able to simply cast miNew as Object and get away with it. But for now, it’s strongly type and will strongly fail if the embedded attachments is not mail. I’ll deal with that when it happens, but for now I don’t care enough.

If it’s not embedded, it’s opened in the same manner as the prior code.

Public Sub DisplayAttachment(olAtt As Attachment, sFile As String, sPath As String)

Dim oShell As Object
Dim miNew As MailItem

If olAtt.Type = olEmbeddeditem Then
Set miNew = Application.GetNamespace("MAPI").OpenSharedItem(sPath & sFile)
miNew.Display
Else
sFile = GetShortFileName(sPath & sFile)
Set oShell = CreateObject("WScript.Shell")
oShell.Run sFile
End If

End Sub

There’s one other problem with this code and that’s the static variable. It doesn’t get reset when a different email is opened. If I open one attachment of three, then use this code on a different email, it will open the second attachment rather than the last. The first email has three attachments, so the code will select the third. The next email has, say, four attachments. When the code runs again, lAtt will be 3, then changed to 2. The solution is to make lAtt a public variable and code up some event that resets it when a different email is active. Meh. It works well enough.

Leave a Reply

Your email address will not be published. Required fields are marked *