'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 |