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:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
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.
Posting code? Use <pre> tags for VBA and <code> tags for inline.