web-dev-qa-db-ja.com

ExcelからVBAを使用してOutlookメールの.msgファイルを開く

VBAを使用して指定したディレクトリから.msgファイルを開くを試みていますが、ランタイムエラーが発生し続けます。

私が持っているコード：

Sub bla()
    Dim objOL As Object
    Dim Msg As Object
    Set objOL = CreateObject("Outlook.Application")
    inPath = "C:\Users\SiliconPlus\Desktop\Si+ Contact Lists\Contact_Si+"
    thisFile = Dir(inPath & "\*.msg")
    Set Msg = objOL.CreateItemFromTemplate(thisFile)
    ' now use msg to get at the email parts
    MsgBox Msg.Subject
    Set objOL = Nothing
    Set Msg = Nothing
End Sub

ランタイムエラーは次のとおりです。

実行時エラー '-2147287038（80030002）'：

ファイルを開けません：AUTO Andy Low Yong Chengは不在です（22 09 2014を返します）。

ファイルが存在しないか、ファイルを開く権限がないか、別のプログラムで開いている可能性があります。ファイルを含むフォルダーを右クリックし、[プロパティ]をクリックして、フォルダーのアクセス許可を確認します。

excelvbaoutlookoutlook-vba
8
Kenneth Li

Kenneth Liファイルを開くときに完全なパスがありませんでした。これを試して：

Sub bla_OK()
Dim objOL As Object
Dim Msg As Object
Set objOL = CreateObject("Outlook.Application")
inPath = "C:\Users\SiliconPlus\Desktop\Si+ Contact Lists\Contact_Si+"
thisFile = Dir(inPath & "\*.msg")
'Set Msg = objOL.CreateItemFromTemplate(thisFile)
Set Msg = objOL.Session.OpenSharedItem(inPath & "\" & thisFile)
' now use msg to get at the email parts
MsgBox Msg.Subject
Set objOL = Nothing
Set Msg = Nothing
End Sub
3
Miguel

エラーが発生した場合は、遅延入札をお試しください（Dim Msg As Object）MsgBoxのすぐ下（コメント解除する必要があります）：

Sub Kenneth_Li()
    Dim objOL As Outlook.Application
    Dim Msg As Outlook.MailItem
    Msgbox "If you get an error, try the Late Biding right under this (need to be uncommented)"
    'Dim objOL As Object
    'Dim Msg As Object

    Set objOL = CreateObject("Outlook.Application")
    inPath = "C:\Users\SiliconPlus\Desktop\Si+ Contact Lists\Contact_Si+"

    thisFile = LCase(Dir(inPath & "\*.msg"))
    Do While thisFile <> ""

        'Set Msg = objOL.CreateItemFromTemplate(thisFile)
        'Or
        'Set Msg = objOL.OpenSharedItem(thisFile)
        'Set Msg = GetNameSpace("MAPI").OpenSharedItem(thisFile)

        'Eventually with Shell command (here for notepad)
        'Shell "notepad " & thisFile
        Set Msg = objOL.Session.OpenSharedItem(thisFile)


        Msg.display

        MsgBox Msg.Subject
        thisFile = Dir
    Loop


    Set objOL = Nothing
    Set Msg = Nothing
End Sub

または、ニースVBソリューションがそこにあります： http://www.mrexcel.com/forum/Excel-questions/551148-open-msg-file-using-visual -basic-applications.html＃post2721847

Shellメソッドの詳細については、こちらをご覧ください。 http://p2p.wrox.com/access-vba/27776-how-open-msg-file-vbulletin.html#post138411

2
R3uK

別の方法は、プログラムでファイルを実行することです（VBAではShellコマンドを使用します）。 Outlookで開き、アイテムを開いた状態でアクティブなインスペクターウィンドウを表示できます。

1
Eugene Astafiev

あなたはフォローコードをチェックする必要があり、あなたのコードを変更することができます

Sub CreateFromTemplate() 
Dim MyItem As Outlook.MailItem 
Set MyItem = Application.CreateItemFromTemplate("C:\temp\*.msg") 
MyItem.Display 
End Sub
0
Khamill

これを試して

Sub GetMSG()
' True includes subfolders
' False to check only listed folder
   ListFilesInFolder "C:\Users\lengkgan\Desktop\Testing", True
End Sub


Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim strFile, strFileType, strAttach As String
    Dim openMsg As MailItem

Dim objAttachments As Outlook.Attachments
Dim i As Long
Dim lngCount As Long
Dim strFolderpath As String

'where to save attachments
strFolderpath = "C:\Users\lengkgan\Desktop\Testing"

    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)

    For Each FileItem In SourceFolder.Files

    strFile = FileItem.Name

' This code looks at the last 4 characters in a filename
' If we wanted more than .msg, we'd use Case Select statement
strFileType = LCase$(Right$(strFile, 4))
  If strFileType = ".msg" Then
    Debug.Print FileItem.Path

Set openMsg = Outlook.Application.CreateItemFromTemplate(FileItem.Path)
openMsg.Display
    'do whatever

Set objAttachments = openMsg.Attachments
    lngCount = objAttachments.Count

    If lngCount > 0 Then

    For i = lngCount To 1 Step -1

    ' Get the file name.
    strAttach = objAttachments.Item(i).Filename

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

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

    Next i
    End If
  openMsg.Close olDiscard

Set objAttachments = Nothing
Set openMsg = Nothing

' end do whatever
      End If
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
      Next SubFolder
    End If

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing

End Sub

編集：参照を追加する方法
[ツール]> [参照]をクリックします。必要な参照を確認してください enter image description here

0
keong kenshih