Vba 自动下载电子邮件附件已停止工作

所以，我有一些非常基本的代码来自动下载电子邮件附件。在相当长的一段时间内，它一直运转良好，并且突然开始出问题。请注意：

1） 几周前，它开始轻率地运行——只要重新运行该规则，它就会正确地下载所有内容。没问题，如果我们能把它恢复到这种状态，我会很高兴的

2） 规则存储在客户端。我们最近搬走了办公桌，这就需要重新创建（阅读：复制和粘贴）我们的所有规则。这在几天内效果良好，然后更大的问题开始了，也就是说，它根本不起作用。当我试图手动运行该规则时，它只是在几秒钟后“短路”——我怀疑当它到达“运行宏”部分时。自动下载不起作用，手动运行规则不起作用

请注意：

1） 宏已启用
2） 宏安全设置为“运行所有宏”
3） 代码存储在模块1中，然后存储在“ThisOutlookSession”中。来回改变没有任何影响
4） 这已经影响了好几个人——我已经为几个不同的人设置了自动下载，而且我们都很兴奋。公平地说，在我们搬桌子之前，我没有把它们放好。我在另外两台计算机上尝试过类似的故障排除步骤。不走运
5） 除了Microsoft office程序外，我不能使用任何程序。无法使用Python或任何其他类型的外部程序

原始代码：

Public Sub SaveDownPriceFilesforMargin(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment


Dim saveFolder As String


saveFolder = "FilePathHere"

     For Each objAtt In itm.Attachments

          objAtt.SaveAsFile saveFolder & objAtt.DisplayName

          Set objAtt = Nothing
     Next
 End Sub

当前代码迭代：

Public Sub SaveDownPriceFilesforMargin(itm As Outlook.MailItem)

On Error GoTo ErrorHandler
Dim objAtt As Outlook.Attachment

Dim dt As String

Dim saveFolder As String

dt = Format(Date, "MMDDYY")

saveFolder = "FilePathHere"

     For Each objAtt In itm.Attachments

          objAtt.SaveAsFile saveFolder & objAtt.DisplayName

          Set objAtt = Nothing
     Next
ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit

End Sub

需要说明的是，我所做的主要更改是在此处找到的代码：。这并没有导致问题的解决

未生成任何错误消息

编辑：当规则自然捕获电子邮件时，偶尔会生成“操作失败”错误消息。当我尝试手动运行规则时，此错误消息不会运行

如何使自动附件重新工作

还有一个附带说明，因为我在这里：如果能想出如何只取下载名并分别获取扩展名，那就太好了——例如，ExcelFile.Xlsx被解析为“ExcelFile”和“.xslx”——但这是一个单独的小问题，我可能可以通过大量的谷歌搜索找到

编辑：

1） 停止工作-规则将移动文件，但不再下载文件。当规则被传入的电子邮件触发时，偶尔会弹出一条错误消息。手动运行规则时不会出现错误消息

2） 从代码中编辑日期

3） 路径是代码中定义的绝对路径。我有权限写入有问题的文件夹，并且必须在之后手动将文件保存到该位置

---

4） Exchange安装程序正在更改-我没有收到Exchange服务器已更改任何内容的通知。

确切地说，“停止工作”是什么意思？脚本是否运行并退出（不保存任何内容？）。脚本从未运行过吗？你怎么称呼这个脚本？Outlook服务器上是否有任何更改？“规则”到底是什么？更多细节将有助于故障排除…顺便说一句-您将变量

dt

设置为日期，但从未对其执行任何操作。。。为什么？“FilePathHere”是有效（绝对）路径吗？你有权限写入那个目录吗？您是否可以让代码将一些信息打印到调试窗口（例如，

debug.print“Processing item”&itm.Subject

）以查看它何时/何地停止工作？您是否尝试过删除规则并重新创建它？曼纽尔，你是怎么执行规则的？从代码中删除

Set objAtt=Nothing

，

原始代码：

并将代码放入新模块1-确保没有重复的模块名称或与我尝试删除和重新创建的子过程名称相同的子过程名称。有时它会让它工作一天左右（只有其中一些！），然后又停止工作。“停止工作”到底是什么意思？脚本是否运行并退出（不保存任何内容？）。脚本从未运行过吗？你怎么称呼这个脚本？Outlook服务器上是否有任何更改？“规则”到底是什么？更多细节将有助于故障排除…顺便说一句-您将变量

dt

设置为日期，但从未对其执行任何操作。。。为什么？“FilePathHere”是有效（绝对）路径吗？你有权限写入那个目录吗？您是否可以让代码将一些信息打印到调试窗口（例如，

debug.print“Processing item”&itm.Subject

）以查看它何时/何地停止工作？您是否尝试过删除规则并重新创建它？曼纽尔，你是怎么执行规则的？从代码中删除

Set objAtt=Nothing

，

原始代码：

并将代码放入新模块1-确保没有重复的模块名称或与我尝试删除和重新创建的子过程名称相同的子过程名称。它有时会让它工作一天左右（而且只有其中一些！），然后又停止工作。