'Store name of email attachment - gives error on first run but works on second run

I'm attempting to open a dot .eml file stored locally and access the attachments file name with a excel macro. I've gathered some code that does the job but not really. Opening the .eml file works (Set Myinspect = OL.ActiveInspector), but on the next line (Set MyItem = Myinspect.CurrentItem) I get the error "Run-time error '91' - Object variable or With block variable not set".

However if I re-run the code from the beginning after the first attempt (with the email now open from the last run), I get the name of the attachment without errors, and here naturally the first instance of the email closes and a second instance is opened. If I remove the line "MyItem.Close 1" I will have two instances of the email after the second run.

I suspected this might be due to that the email did not have time to open and load before the code tried to retrieve the name of the attachment, hence I tried to put a MsgBox before setting "Myitem" and wait until the email had loaded but that did not do the trick..

Appreciate any help that can be provided on this. The end use of the code is to loop through a list of .eml files to search for a .eml file with a attachment with a pre-determined name and then return the name of the .eml file, so since it loops a faster solution then "wait 5 seconds" for example would be optimal.

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As 
Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal 
lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWMINIMIZED As Long = 2

Sub test11()
strMyFile = "C:\test1.eml"
Dim Myinspect As Outlook.Inspector
Dim MyItem As Outlook.MailItem
Dim OL As Object

If Dir(strMyFile) = "" Then
    MsgBox "File " & strMyFile & " does not exist"
Else
    ShellExecute 0, "Open", strMyFile, "", "C:\test1.eml", SW_SHOWNORMAL
End If

Set OL = CreateObject("Outlook.Application")
Set Myinspect = OL.ActiveInspector
Set MyItem = Myinspect.CurrentItem
MsgBox "Attachment = " & MyItem.Attachments(1)
MyItem.Close 1

End Sub


Solution 1:[1]

Please, try replacing of:

ShellExecute 0, "Open", strMyFile, "", "C:\test1.eml", SW_SHOWNORMAL

with

Const waitOnReturn as boolean = True

VBA.CreateObject("WScript.Shell").Run """" & strMyFile & """", 1, waitOnReturn

This version will wait for the application to open the file. At least, theoretically...:) And no need of any API.

Please, send some feedback after testing it.

Solution 2:[2]

You are getting that error because you need to give enough time for the reading pane to become visible. Is this what you are trying?

Option Explicit

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr

Private Const SW_SHOWNORMAL As Long = 1
Private Const strMyFile As String = "C:\test1.eml"
Dim Retry As Long

Sub Sample()
    Dim Myinspect As Outlook.Inspector
    Dim MyItem As Outlook.MailItem
    Dim OL As Object
    
    If Dir(strMyFile) = "" Then
        MsgBox "File " & strMyFile & " does not exist"
        Exit Sub
    Else
        ShellExecute 0, "Open", strMyFile, "", strMyFile, SW_SHOWNORMAL
    End If
    
    Set OL = CreateObject("Outlook.Application")
    Set Myinspect = OL.ActiveInspector
    
    '~~> Wait till the reading pane is visible
    Do While TypeName(Myinspect) = "Nothing"
        '~~> Wait for 1 sec
        Wait 1
        Set Myinspect = OL.ActiveInspector
        
        '~~> After 10 retries, stop retrying
        If Retry > 10 Then Exit Do
    Loop
    
    If TypeName(Myinspect) = "Nothing" Then
        MsgBox "Unable to get the Outlook Inspector"
        Exit Sub
    End If
    
    Set MyItem = Myinspect.CurrentItem
    MsgBox "Attachment = " & MyItem.Attachments(1)
    MyItem.Close 1
End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer: DoEvents: Wend
    Retry = Retry + 1
End Sub

Note: Instead of Do While TypeName(Myinspect) = "Nothing", you can also use Do While Myinspect Is Nothing

    '~~> Wait till the reading pane is visible
    Do While Myinspect Is Nothing
        '~~> Wait for 1 sec
        Wait 1
        Set Myinspect = OL.ActiveInspector
        
        '~~> After 10 retries, stop retrying
        If Retry > 10 Then Exit Do
    Loop
    
    If Myinspect Is Nothing Then
        MsgBox "Unable to get the Outlook Inspector"
        Exit Sub
    End If

Solution 3:[3]

Opening and showing an EML file to an end-user when all you want is the attachment name may or may not be what the user expects.

I am not aware of any libraries that would let you open EML files directly from VBA, but if using Redemption (I am its author) is an option, you can create a temporary MSG file and import the EML file. You can then access the message without showing it to the user. Something along the lines

  set Session = CreateObject("Redemption.RDOSession")
  Session.MAPIOBJECT = OutlookApplication.Session.MAPIOBJECT
  set Msg = Session.CreateMessageFromMsgFile("c:\temp\test.msg")
  Msg.Import "c:\temp\test.eml", 1031
  Msg.Save
  for each attach in Msg.Attachments
    MsgBox attach.FileName
  next

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1
Solution 2
Solution 3