Open Outlook Mail .msg file using VBA from Excel - excel

Question

I'm trying to open .msg files from a specified directory using VBA but I keep getting a runtime error.
The code i have:
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
Here is the runtime error:
Run-time error '-2147287038 (80030002)':
Cannot open file: AUTO Andy Low Yong Cheng is out of the office (returning 22 09 2014).msg.
The file may not exist, you may not have permission to open it, or it may be open in another program. Right-click the folder that contains the file, and then click properties to check your permissions for the folder.

Answer 1

Kenneth Li You didn't had the full path when opening the file. Try this:
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

Answer 2

If you get an error, try the Late Biding (Dim Msg As Object) right under the MsgBox (need to be uncommented) :
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
Or you can find a nice VB solution there : http://www.mrexcel.com/forum/excel-questions/551148-open-msg-file-using-visual-basic-applications.html#post2721847
And here for more details on Shell method : http://p2p.wrox.com/access-vba/27776-how-open-msg-file-vbulletin.html#post138411

Answer 3

Another way is to run the file programmatically (in VBA use the Shell command). It will be opened in Outlook where you can get an active inspector window with the item opened.

Answer 4

You should check follow code and can modify your code
Sub CreateFromTemplate()
Dim MyItem As Outlook.MailItem
Set MyItem = Application.CreateItemFromTemplate("C:\temp\*.msg")
MyItem.Display
End Sub

Answer 5

Try this
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
Edited : How to add the reference
Click Tools > Reference.
Check the needed reference