.msg 파일을 열 수 없습니다.

Question

저는 열 필요가있는 약 .msg, outlook 파일이 있으며, Excel 첨부 파일을 .csv 파일로 변환하고 저장하지 않아도됩니다. 현재 아래의 코드는 .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