Question

我正在尝试将电子邮件附带的每日系统生成的报告保存到文件夹中。我的脚本保存并重命名了文件，但是当我尝试打开文件时，它说： Microsoft Excel无法打开或修复该工作簿，因为它已损坏。脚本下方：

Public Sub UnzipFileInOutlook(itm As Outlook.MailItem)
 Dim objAtt As Outlook.Attachment
 Dim saveFolder As String
 saveFolder = "C:\Users\acheng\Desktop"
 For Each objAtt In itm.Attachments
 objAtt.SaveAsFile saveFolder & "\Order_History_Report.xlsx"
 Set objAtt = Nothing
 Next

结束子

Answer 1

我不明白：“当我仅使用代码objAtt.SaveAsFile saveFolder时，文件没有损坏。”

除非我在路径中包含文件名，否则SaveAsFile总是因错误而停止。我已经尝试了所有可以想到的变体，但是没有一个可以保存文件。

我从未SaveAsFile损坏过文件。我的理论是，您的电子邮件包含多个附件，而您保存的是错误的附件。您的代码：

saveFolder = "C:\Users\acheng\Desktop"
For Each objAtt In itm.Attachments
   objAtt.SaveAsFile saveFolder & "\Order_History_Report.xlsx"
   Set objAtt = Nothing
Next

如果电子邮件具有两个附件，则此代码将：

将第一个附件保存为“ C：\ Users \ acheng \ Desktop \ Order_History_Report.xlsx”，覆盖从昨天起保留的任何此名称的文件。
将第二个附件保存为“ C：\ Users \ acheng \ Desktop \ Order_History_Report.xlsx”，并覆盖第一个附件。

当今大多数电子邮件都将HTML图像用作徽标和图片，但仍有一些电子邮件仍使用嵌入式图像，这些图像作为附件携带，但没有作为附件报告给用户。

下面的代码将检验我的理论。将此代码复制到新模块：

Option Explicit
Public Sub InvestigateEmails()

  Dim Exp As Explorer
  Dim InxA As Long
  Dim ItemCrnt As MailItem

  Set Exp = Outlook.Application.ActiveExplorer

  If Exp.Selection.Count = 0 Then
    Call MsgBox("Pleaase select one or more emails then try again", vbOKOnly)
    Exit Sub
  Else
    For Each ItemCrnt In Exp.Selection
      With ItemCrnt
        Debug.Print "From (Sender email address): " & .SenderEmailAddress
        Debug.Print "Subject: " & .Subject
        Debug.Print "Sent on: " & .SentOn
        Debug.Print "Received: " & .ReceivedTime
        If .Attachments.Count = 0 Then
          Debug.Print "No attachments"
        Else
          Debug.Print "Attachments:"
          Debug.Print "No.|Type|Path|Filename|DisplayName|"
          For InxA = 1 To .Attachments.Count
            With .Attachments(InxA)
              Debug.Print InxA & "|";
              Select Case .Type
                Case olByValue
                  Debug.Print "Val";
                Case olEmbeddeditem
                  Debug.Print "Ebd";
                Case olByReference
                  Debug.Print "Ref";
                Case olOLE
                  Debug.Print "OLE";
                Case Else
                  Debug.Print "Unk;"
              End Select
              ' Not all types have all properties.  This code handles
              ' those missing properties of which I am aware.  However,
              ' I have never found an attachment of type Reference or OLE.
              ' Additional code may be required for them.
              Select Case .Type
                Case olEmbeddeditem
                  Debug.Print "|";
                Case Else
                  Debug.Print "|" & .PathName;
              End Select
              Debug.Print "|" & .Filename;
              Debug.Print "|" & .DisplayName & "|"
            End With
          Next
        End If
        Debug.Print "--------------------------"
      End With
    Next
  End If

End Sub

要使用此代码，请选择要处理的一封或多封电子邮件，然后运行InvestigateEmails。它将为每个选定的电子邮件输出选择的属性。您的即时窗口将类似于：

From (Sender email address): a.j.dallimore@MyIsp.com
Subject: Test
Sent on: 15/11/2018 11:22:41
Received: 15/11/2018 11:22:49
Attachments:
No.|Type|Path|Filename|DisplayName|
1|Val||002 View from back of Neville Tower.jpg|002 View from back of Neville Tower.jpg|
2|Val||image001.jpg|image001.jpg|
--------------------------

我已将上述电子邮件发送给自己。附件1是标头中列出的常规附件，可以将其拖到文件夹中或单击以将其打开。附件2已嵌入并作为图片显示在电子邮件正文中，但未在标题中列出。

我的理论是，给定您的一封电子邮件，InvestigateEmails将在每封电子邮件中列出多个附件，而最后一个附件将不是Excel工作簿。您以“ xlsx”扩展名保存该附件，因此Excel尝试打开它失败。

顺便说一句，每当开发新代码来处理电子邮件时，我都会使用此例程。我可能会计划让新代码运行某个事件或规则，但是此例程使测试变得更加容易。我修改此代码以调用新代码并选择一个简单的电子邮件。当我调试代码以使用简单的电子邮件时，我尝试使用更复杂的电子邮件。没有简单的方法可以控制将哪些电子邮件传递到宏进行处理。我建议您保留此宏以备将来使用。另外，我可以告诉您在哪里可以找到输出到桌面文本文件的较大版本。

此答案的其余部分假定我的理论是正确的。如果我的理论是错误的，我们可能需要进一步调查。

在向您展示如何使用静态文件名保存正确的附件之前，我会说我怀疑这是一个好主意。如果我理解正确，您每天都会收到一个工作簿，该工作簿会覆盖前一天的工作簿。您从工作簿中提取数据并将其保存在数据库中。这似乎是一个好主意，但这可能会带来灾难性的错误。几年前，尽管我没有亲自参与，但我也知道过类似的情况。像您一样，他们正在接收文件，提取数据然后丢弃文件。这一切似乎都可以工作几个月，但是随后他们发现数据没有正确提取。如果他们保留了原始源文件，则修复数据库将很困难，但有可能。但是如果没有原始数据，他们将无能为力。

我建议您使用以下名称保存文件：“ Order_History_Report 181115.xlsx”。这将使您可以存档所有原始文件，以防将来需要重新处理它们。处理具有这样名称的文件会有些困难，但是我可以解释如何执行此操作。

返回您的代码，最简单的纠正方法是：

For Each objAtt In itm.Attachments
   If LCase(Right$(objAtt.DisplayName, 4)) = ".xlsx" Then
     objAtt.SaveAsFile saveFolder & "\Order_History_Report.xlsx"
     Set objAtt = Nothing
     Exit For
   End If
Next

此代码将忽略不是常规工作簿的所有附件，一旦找到常规工作簿，便不再寻找更多附件。

使用格式xlsx以静态名称保存和重命名Outlook附件

1 个答案: