电子邮件附件的存储名称 - 在第一个运行时出错，但在第二个运行时有效

Question

我正在尝试打开本地存储的点 .eml 文件并使用 excel 宏访问附件文件名。我已经收集了一些代码来完成这项工作但不是真的。打开 .eml 文件有效（Set Myinspect = OL.ActiveInspector），但在下一行（Set MyItem = Myinspect.CurrentItem）我收到错误“运行-time error '91' - Object变量或 With 块变量未设置。

但是，如果我在第一次尝试后重新运行代码（现在从上次运行打开电子邮件），我会毫无错误地得到附件的名称，在这里，电子邮件的第一个实例自然关闭，第二个实例打开。如果我删除行“MyItem.Close 1”，我将在第二个运行.

之后有两个电子邮件实例

我怀疑这可能是因为在代码尝试检索附件名称之前电子邮件没有时间打开和加载，因此我尝试在设置“Myitem”之前放置一个 MsgBox 并等到电子邮件已加载，但没有成功..

感谢您为此提供的任何帮助。代码的最终用途是循环遍历 .eml 文件列表，以搜索带有预定名称附件的 .eml 文件，然后 return .eml 文件的名称，因此由于它循环一个更快的解决方案然后“等待 5 秒”将是最佳的。

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

Answer 1

请尝试更换：

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

和

Const waitOnReturn as boolean = True

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

此版本将等待应用程序打开文件。至少，理论上......:)而且不需要任何 API.

请在测试后发送一些反馈。

Answer 2

您收到该错误是因为您需要留出足够的时间让阅读窗格可见。这是你正在尝试的吗？

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

注：代替Do While TypeName(Myinspect) = "Nothing"也可以用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

Answer 3

打开 EML 文件并将其显示给最终用户，而您只需要附件名称可能是也可能不是用户期望的名称。

我不知道有任何库可以让您直接从 VBA 打开 EML 文件，但是如果使用 Redemption（我是它的作者）是一个选项，您可以创建一个临时文件MSG 文件并导入 EML 文件。然后您可以访问该消息而无需将其显示给用户。沿线的东西

  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

电子邮件附件的存储名称 - 在第一个运行时出错，但在第二个运行时有效

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

excel

outlook

vba

eml

电子邮件附件的存储名称 - 在第一个 运行 时出错，但在第二个 运行 时有效

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

excel

outlook

vba

eml

电子邮件附件的存储名称 - 在第一个运行时出错，但在第二个运行时有效