outlook VBA 将附件保存在硬盘驱动器上，到不同于“我的文档文件夹”的特定文件夹

Question

我发现了一个宏，它可以在 Outlook 上保存电子邮件中的附件，在这方面它工作得很好，但它将其保存在“我的文档”文件夹中

我希望它将其保存在另一个具有完全不同路径的文件夹中，但是我很难看到执行此操作的代码如何工作，因此我无法成功修改它

我的文档文件夹的当前路径是 C:\Users\me\Documents\OLAttachments，但它应该是 Y:\work_network\me\outlook-file

我现在的代码是

Public Sub SaveAttachments()

Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

' Get the path to your My Documents folder
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
On Error Resume Next

' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")

' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

' Set the Attachment folder.
strFolderpath = strFolderpath & "\OLAttachments\"

' Check each selected item for attachments.
For Each objMsg In objSelection

Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count

If lngCount > 0 Then
For i = lngCount To 1 Step -1

' Get the file name.
strFile = Left(objAttachments.Item(i).FileName, Len(stry) - 4) & Format(Date, "DDMMYY") & ".xls"

' Combine with the path to the Temp folder.
strFile = strFolderpath & strFile

' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile

Next i
End If

Next

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

我真的不明白这句话是怎么回事

strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)

我很难使它适应我的需要。

有人能帮忙吗？非常感谢

Answer 1

上述代码获取“我的文档”特殊文件夹的路径。您只需将此行替换为：

strFolderpath = "Y:\work_network\me\outlook-file\"

并完全删除此行：

strFolderpath = strFolderpath & "\OLAttachments\"