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

Posted 2023-03-15

【中文标题】电子邮件附件的存储名称 - 第一次运行时出错，但在第二次运行时有效

【英文标题】：Store name of email attachment - gives error on first run but works on second run

【发布时间】：2021-09-16 01:38:29

【问题描述】：

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

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

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

感谢您对此提供的任何帮助。代码的最终用途是遍历 .eml 文件列表以搜索带有预先确定名称的附件的 .eml 文件，然后返回 .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

【参考方案1】：

请尝试替换：

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

与

Const waitOnReturn as boolean = True

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

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

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

【讨论】：

您好 FaneDuru，感谢您的回复，除了您的解决方案完美运行之外，没有太多反馈可以提供，谢谢！

@Viktor Rst 很高兴我能帮上忙！

【参考方案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

【讨论】：

感谢您的回复，我尝试使用您的解决方案，效果很好，谢谢您！

【参考方案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