无法打开.msg文件
问题描述：
我有大约90。味精，我需要打开Outlook文件，转换成Excel附件为.csv文件，并保存了。目前，下面的代码是简单地打开.msg展望文件，但出现错误：无法打开.msg文件
如何允许打开.msg文件。
脚本：
Sub OpenMSGRenameDownloadAttachement()
Dim objOL As Outlook.Application
Dim Msg As Outlook.MailItem
Dim MsgCount As Integer
Set objOL = CreateObject("Outlook.Application")
'Change the path given month, ie. do this for Jan, Feb, April
inPath = "C:\January Messages"
thisFile = LCase(Dir(inPath & "\*.msg"))
Do While thisFile <> ""
Set Msg = objOL.Session.OpenSharedItem(thisFile)
Msg.Display
MsgBox Msg.Subject
thisFile = Dir
Loop
Set objOL = Nothing
Set Msg = Nothing
End Sub
答
试试这个：
Sub OpenMSGRenameDownloadAttachement()
Dim Msg As Outlook.MailItem
Dim objAtt As Outlook.Attachment
Set objOL = CreateObject("Outlook.Application")
Set objNs = objOL.GetNamespace("MAPI")
'objNs.Logon
inPath = "C:\January Messages\"
outPath = "C:\January Messages\attachments\" 'create this folder for attachments or use your own
thisFile = Dir(inPath & "*.msg")
Do While Len(thisFile) > 0
Set Msg = objNs.OpenSharedItem(inPath & thisFile)
'MsgBox inPath & thisFile
'MsgBox Msg.Subject
'MsgBox Msg.SenderEmailAddress
'MsgBox Msg.Recipients.Item(1).Address
For Each objAtt In Msg.Attachments
If Right(objAtt, 4) = "xlsx" Or Right(objAtt, 3) = "xls" Then
objAtt.SaveAsFile outPath & Split(objAtt.DisplayName, ".")(0) & ".csv"
End If
Next
thisFile = Dir
Loop
Set objOL = Nothing
Set objNs = Nothing
End Sub
我想这是一个明显的问题，但该文件已经打开？例如。在Outlook中？或者在Excel中，您的代码在早期尝试失败？或从以前的成功尝试在Excel中？ （它看起来并不像您明确正在执行“Close”，因此它可能仍然是开放的。）此外，此页面是否适用：https://support.microsoft.com/zh-cn/help/2633737/the -openshareditem-method-for-outlook-holds-a-file-handle-on-signed-.msg-files – YowE3K
这是一次性的事情。我如何重写这个工作，至少打开邮件，我可以从那里转换excel。 – Sauron
您正在使用Dir错误。尝试使用'thisFile = Dir（inPath）'并在'Do While thisFile “”'后放置一个If条件'如果Right（thisFile，3）=“msg”Then''，并且不需要物理地打开消息据我所知，获得附件。 – Tehscript