无法重命名和删除规则中代码的附件

Question

我有这个代码，它的工作是从outlook和本地文件夹中获取附件。我已经尝试修改它以重命名文件并从outlook中删除电子邮件，这就是它停止工作的地方。

当电子邮件进入新文件夹时，该规则会移动电子邮件，然后将附件保存到我的C驱动器上的文件夹中。每天只有1封电子邮件，每天只有一个附件。

我想将附件保存到文件夹，重命名附件（覆盖现有文件），并从outlook中删除电子邮件。

这是我到目前为止的代码。

任何帮助，将不胜感激

Public Sub SaveAttachments(Item As Outlook.MailItem)

If Item.Attachments.Count > 0 Then

Dim objAttachments As Outlook.Attachments
Dim lngCount As Long
Dim strFile As String
Dim sFileType As String
Dim i As Long

Set objAttachments = Item.Attachments
lngCount = objAttachments.Count
For i = lngCount To 1 Step -1

' Get the file name.
strFile = objAttachments.Item(i).FileName

' Get the path to your My Documents folder
strfolderpath = "C:\Automation\CBM\"
'strfolderpath = strfolderpath & "\Attachments\"

' Combine with the path to the folder.
strFile = strfolderpath & strFile

' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile FilePath & "Daily_Activity_Report" & 
".xlsx"

' Delete the attachment.
objAttachments.Item(i).Delete

Next i
End If

End Sub

Answer 1

试试这个：

Public Sub SaveAttachments(Item As Outlook.MailItem)

Dim objAttachments As Outlook.Attachments
Dim lngCount As Long
Dim i As Long

If Item.Attachments.Count > 0 Then

    Set objAttachments = Item.Attachments

    lngCount = objAttachments.Count

    For i = lngCount To 1 Step -1

        'Save the attachment as a file.
        objAttachments.Item(i).SaveAsFile "C:\Automation\CBM\Daily_Activity_Report.xlsx"

        'Delete the attachment.
        objAttachments.Item(i).Delete

    Next i

    Item.Save

End If

End Sub