は、私は約90 .MSG、私は、開いているファイルを.csvファイルとオフを保存するために、Excelの添付ファイルを変換する必要がOutlookファイルを持って.MSGファイルに

Question

を開くことができません。現在、以下のコードは.msg outlookファイルを開くだけですが、エラーが表示されます。

.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 

Answer 1

はこれを試してみてください：

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