Outlook VBA: 并非所有邮件项目都无法识别

Question

我从网上的帮助教程中获得了代码。我对其进行了测试，并确保更新了我本地系统特有的任何变量。

但是，我遇到了 outlook 导出问题。

之前，我运行代码成功。获取了Outlook文件夹的全部128项

outlook 文件夹中现在有 231 个项目。代码，反复只得到其中的162个

就是这个问题，我需要全231

我可以确认以下内容；

所有 Ol 项目都是邮件（不是会议或已读回执）
获得的162条包含附件-在此基础上不做限制
我已经多次刷新并与本地计算机同步 outlook 交换。但是没有改善。
以前，一封邮件的邮件标题中包含 ***。这破坏了代码，我修改了它，可以看到，它运行没有问题。

有什么想法吗？

我考虑过

邮件是我没有定义的类型？
其他邮件的标题有问题吗？
此代码在某种程度上受到内存分配的限制？
问题出在Ol交易所和本地设备之间的同步问题

Sub ZipAllEmailsInAFolder()
Dim objFolder As Outlook.Folder
Dim objItem As Object
Dim objMail As Outlook.MailItem
Dim strSubject As String
Dim varTempFolder As Variant
Dim varZipFile As Variant
Dim objShell As Object
Dim objFileSystem As Object

'Select an Outlook Folder
Set objFolder = Outlook.Application.Session.PickFolder

If Not (objFolder Is Nothing) Then
   'Create a temp folder
   varTempFolder = "C:\Users\thomdenm\Music\" & objFolder.Name & Format(Now, "YYMMDDHHMMSS")
   MkDir (varTempFolder)
   varTempFolder = varTempFolder & "\"

   'Save each email as msg file
   For Each objItem In objFolder.Items

       If TypeOf objItem Is MailItem Then
          Set objMail = objItem
          strSubject = objMail.Subject
          strSubject = Replace(strSubject, "/", " ")
          strSubject = Replace(strSubject, "\", " ")
          strSubject = Replace(strSubject, ":", "")
          strSubject = Replace(strSubject, "?", " ")
          strSubject = Replace(strSubject, Chr(34), " ")
          strSubject = Replace(strSubject, "*", " ")

          objMail.SaveAs varTempFolder & strSubject & ".msg", olMSG
       End If
   Next

   'Create a new ZIP file
   varZipFile = "C:\Users\thomdenm\Music\" & objFolder.Name & " Emails.zip"
   Open varZipFile For Output As #1
   Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
   Close #1

   'Add the exported msg files to the ZIP file
   Set objShell = CreateObject("Shell.Application")
   objShell.NameSpace(varZipFile).CopyHere objShell.NameSpace(varTempFolder).Items

   On Error Resume Next
   Do Until objShell.NameSpace(varZipFile).Items.Count = objShell.NameSpace(varTempFolder).Items.Count
      Application.Wait (Now + TimeValue("0:00:01"))
   Loop
   On Error GoTo 0

   'Delete the temp folder
   Set objFileSystem = CreateObject("Scripting.FileSystemObject")
   objFileSystem.DeleteFolder Left(varTempFolder, Len(varTempFolder) - 1)
End If

结束子

Answer 1

首先，我会删除您检查项目类型或添加其他条件以确保所有项目都得到处理的条件。或者只是添加一个计数器以查看检查了多少项目。

counter = counter+1
If TypeOf objItem Is MailItem Then

其次，如果出现任何错误，On Error statement 可以帮助您确定问题的根源。

第三，拆分获取 Outlook 项目并将它们保存到文件夹的逻辑是有意义的。另一段代码可以提取到单独的方法中，因此按照这种方式您可以轻松确保一个或另一个方法正常工作（与 Outlook 相关的部分）。

最后，最重要的是项目可以属于同一个对话并且具有相同的主题行，这可能会导致覆盖文件夹中保存的项目。是这样吗？

objMail.SaveAs varTempFolder & strSubject & ".msg", olMSG

我建议在文件名中添加任何 ID，这样您就可以确保文件夹中没有任何项目被覆盖。比如可以是当前时间，也可以是毫秒等

Outlook VBA: 并非所有邮件项目都无法识别

Outook VBA: not all mail items are not recognized

outlook

vba