如何获取当前打开的.msg文件所在文件夹路径？Outlook VBA问题

问题描述 #

我有一段可将所有附件下载至指定文件夹的Outlook VBA代码。目前我的邮件以.msg格式存储在路径C:\Users\username\Documents\emails中，我希望通过MsgBox显示刚打开的该邮件文件所在的文件夹路径，预期结果为C:\Users\username\Documents\emails。但我尝试使用CurDir()时，返回的是C:\Users\username\Documents；使用以下代码也得到相同结果：

Sub SaveOlAttachments()
Dim app As Outlook.Application
Dim Msg As Outlook.MailItem
Dim att As Outlook.attachment
Dim strFilePath As String
Dim strAttPath As String
Dim wshell As Object
Set wshell = CreateObject("WScript.Shell")

Set app = New Outlook.Application

'path for creating msgs
strFilePath = wshell.CurrentDirectory & "\emails\"
MsgBox (strFilePath)
'path for saving attachments
strAttPath = strFilePath & "\attachments\"
Do While Len(strFile) > 0
    Set Msg = app.CreateItemFromTemplate(strFilePath & strFile)
    If Msg.Attachments.Count > 0 Then
         For Each att In Msg.Attachments
             att.SaveAsFile strAttPath & att.FileName
         Next
    End If
    strFile = Dir
Loop

End Sub

为何不能固定路径？ #

邮件将被移至共享驱动器，且需按客户创建对应文件夹存储邮件及附件，例如：

• Z:\Customer Contact\Customer\JoeBlogs
• Z:\Customer Contact\Customer\JoeBlogs\attachments
• Z:\Customer Contact\Customer\JaneDoe
• Z:\Customer Contact\Customer\JaneDoe\attachments

由于每次触发宏的邮件对应存储路径不同，无法固定路径。

内容的提问来源于stack exchange，提问作者Andrew