Opening an Outlook .msg file with Excel VBA - excel

I have the following code
Sub Kenneth_Li()
Dim objOL As Outlook.Application
Dim Msg As Outlook.MailItem
Set objOL = CreateObject("Outlook.Application")
inPath = "C:\Users\SiliconPlus\Desktop\Si+ Contact Lists\Contact_Si+"
thisFile = Dir(inPath & "\*.msg")
Do While thisFile <> ""
'Set Msg = objOL.CreateItemFromTemplate(thisFile)
'Or
Set Msg = objOL.OpenSharedItem(thisFile)
Msg.display
MsgBox Msg.Subject
thisFile = Dir
Loop
Set objOL = Nothing
Set Msg = Nothing
End Sub
When I use OpenSharedItem it gives a run-time error 438 Object doesn't support this property or method.
When I use CreateItemFromTemplate I get the following error:
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.

I'm not 100% on what you're trying to get at with the code, but try this:
Sub LiminalMsgbx()
Dim outappp, outmaill As Object
Dim pthh As String
pthh = "C:\DeskTop\MyTemplate.oft"
Set outappp = CreateObject ("Outlook.Application")
Set outmaill = outapp.CreateItemFromTemplate(pthh)
With outmaill
.display
End With
Set outappp = Nothing
Set outmaill = Nothing
End Sub
You can also use .send instead of .display.

OpenSharedItem method is exposed by the Namespace object, not Application.
Set objOL = CreateObject("Outlook.Application")
set objNs = objOL.GetNamespace("MAPI")
objNs.Logon
...
Set Msg = objNs .OpenSharedItem(thisFile)
As for the second error, it is pretty unambiguous - the file cannot be found. You must provider a fully qualified file name with the folder path. You are only providing the file name.

Related

Error populating email body from word documents

I am working on an excel macro to send a series of emails each with a unique attachment, and one of three template emails that are saved as word documents. Everything is working well, except pulling the body of the email in from the word document. The problem seems to be with WordEditor. I get the following error
Err.Description:The operation failed.
Err.Number:-2147467259
Err.Source:Microsoft Outlook
Here is the code I have tried:
Sub SendDCLEmails()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim WordApp As Object
Dim WordDoc As Object
Dim DCLFile As String 'Attachment that differs for each email
Dim DCLCount As Integer 'Number of emails that will be sent
Dim toList As String
Dim ccList As String
Dim CoverLetter As String 'Word document template email
Dim fileCheckDCL As String
Dim fileCheckCover As String
Dim editor As Object
'Set references to Outlook
On Error Resume Next
Set OutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutlookApp = New Outlook.Application
On Error GoTo 0
'Set references to Word
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err <> 0 Then Set WordApp = New Word.Application
On Error GoTo 0
Sheets("Contacts").Select
'Create email for each record on "Contacts" tab
DCLCount = ActiveSheet.UsedRange.Rows.Count - 1
For i = 1 To DCLCount
DCLFile = Range("AD1").Offset(i, 0).Value & "\" & Range("AE1").Offset(i, 0).Value
CoverLetter = Range("AF1").Offset(i, 0).Value
fileCheckDCL = Dir(DCLFile)
fileCheckCover = Dir(CoverLetter)
'Run some validations and generate the toList and ccList variables.
Set WordDoc = WordApp.Documents.Open(CoverLetter)
WordDoc.Content.Copy
'Create Emails
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.Display
.To = toList
.CC = ccList
.Subject = Range("AG1").Offset(i, 0).Value
Set editor = .GetInspector.WordEditor 'This is where the error occurs.
editor.Content.Paste
.Attachments.Add DCLFile
.Send
End With
WordDoc.Close savechanges:=False
End If
toList = vbNullString
ccList = vbNullString
CoverLetter = vbNullString
DCLFile = vbNullString
fileCheckDCL = vbNullString
fileCheckCover = vbNullString
Set editor = Nothing
Next i
OutlookApp.Quit
WordApp.Quit
End Sub
There is no need to use late and early-binding technologies in the VBA macros:
Set OutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutlookApp = New Outlook.Application
Instead, you need to use one or another. Read more about that in the Using early binding and late binding in Automation article. I'd suggest declaring all objects with real classes (early-binding), it may allow avoiding mistakes with syntax further. And use the New operator in the code instead of CreateObject one.
Set editor = .GetInspector.WordEditor 'This is where the error occurs.
Calling the WordEditor property may sometimes fail if the Inspector is not yet visible and initialized. Try to call the Display method prior getting the Word editor value.
Also instead of relying on Word documents as templates you may create templates in Outlook and use the Application.CreateItemFromTemplate method which creates a new Microsoft Outlook item from an Outlook template (.oft) and returns the new item. Read more about that in the article which I wrote for the technical blog, see How To: Create a new Outlook message based on a template.

Copy content of Excel attachment in Outlook VBA without saving the file

I get 50 mails with Excel sheets per day. I want to add the first line of each Excel sheet to an existing Excel sheet located on my computer.
I know how to save a file from an email, and then access the first line. I would like to directly access it, without having to save the file.
Something like this:
Sub Merge_Reports(itm As Outlook.MailItem)
Dim wb_path As String
Dim app_master As Object
Dim wb_master As Object
Dim ws_master As Object
Dim objAtt As Outlook.Attachment
Dim ws_email As Object
Dim content As String
wb_path = "\\swi56prof01\UserData$\heinreca\Documents\Outlook-Dateien\AllData.xlsx"
Set app_master = CreateObject("Excel.Application")
Set wb_master = app_master.Workbooks.Open(wb_path)
Set ws_master = wb_master.Sheets(1)
For Each objAtt In itm.Attachments
Set ws_email = objAtt.Sheets(1)
content = ws_email.Cells("A1")
ws_master.Cells("A1") = content
End Sub
I am struggling with ws_email = objAtt.Sheets(1). I get the error
object doesn't support this property or method
I tried this instead of the line that results in the error.
Set app_email = CreateObject("Excel.Application")
Set wb_email = app_email.Workbooks.Open(objAtt)
Set ws_email = wb_email.Sheets(1)
I don't know what objAtt is in terms of data type and how to address the worksheet, so that I can copy the first line from it.
I found Copy Contents of Outlook Attachment and that I have to save the file before accessing it. Is there no other way?
There is no way to access the workbook without saving it to the disk. After saving the attached file to the disk you can use the same code:
Set wb_master = app_master.Workbooks.Open(wb_path)
Set ws_master = wb_master.Sheets(1)
where wb_path is the file path of your saved attachment (Excel file).
The Attachment.SaveAsFile method saves the attachment to the specified path. For example:
Sub SaveAttachment()
Dim myInspector As Outlook.Inspector
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myInspector = Application.ActiveInspector
If Not TypeName(myInspector) = "Nothing" Then
If TypeName(myInspector.CurrentItem) = "MailItem" Then
Set myItem = myInspector.CurrentItem
Set myAttachments = myItem.Attachments
'Prompt the user for confirmation
Dim strPrompt As String
strPrompt = "Are you sure you want to save the first attachment in the current item to the Documents folder? If a file with the same name already exists in the destination folder, it will be overwritten with this copy of the file."
If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
myAttachments.Item(1).SaveAsFile Environ("HOMEPATH") & "\My Documents\" & _
myAttachments.Item(1).DisplayName
End If
Else
MsgBox "The item is of the wrong type."
End If
End If
End Sub

Open Email Attachments File

I have open attachments file using following code
Sub Test()
Dim path As String
Dim msgFile As String
path = Application.ActiveWorkbook.path + "\"
file = path & "\*.msg"
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.mailitem
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate(file)
On Error Resume Next
With OutMail
.To = Application.User
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
But
Email attachments file was not open.
How to Open Email Attachments File in Macro?
The Application class from the Excel object model doesn't provide the User property. Instead, you could use the UserName property which returns the name of the current user.
MsgBox "Current user is " & Application.UserName
The MailItem.To property returns or sets a semicolon-delimited string list of display names for the To recipients for the Outlook item. But I would suggest using the Recipients collection which should be used to modify the To property.

excel vba - open outlook msg file then save as draft

I have the following code. What I would like to be able to do is open the .msg file, amend it to how I want it and then save it into the drafts folder (which is what it would normally happen if it was a new email message). The problem is, the below just saves back to the file, as expected...
Is there anyway that I can force it save into drafts? I have had a good google around and didnt find anything at all, so I am losing hope.
Sub TestMsg()
Dim OL As Object
Dim Msg As Object
Set OL = CreateObject("Outlook.Application")
Set Msg = OL.Session.OpenSharedItem("C:\Users\user\Desktop\Template.msg")
Msg.Body = Msg.Body = " Test Message"
Msg.Save
Set Msg = Nothing
Set OL = Nothing
End Sub
Thanks
https://learn.microsoft.com/en-us/office/vba/api/outlook.application.createitemfromtemplate
has this example:
Sub CreateFromTemplate2()
Dim MyItem As Outlook.MailItem
Set MyItem = Application.CreateItemFromTemplate("C:\statusrep.oft", _
Application.Session.GetDefaultFolder(olFolderDrafts))
MyItem.Save
End Sub

VBA - select the first file from a specific folder and reply all

I saved multiple outlook msg on a specific folder named "email temp folder" and would to reply on the first msg in the folder.
However there is an error: type mismatch occur in the below lines.
Could you somebody help me on this please?
Sub outlookActivate1()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim fso As New FileSystemObject
Dim objFolder As Object
Dim objFile As Object
Dim FileItemToUse As Outlook.MailItem
Dim i As Long
Set OutApp = CreateObject("Outlook.Application")
strPath = "C:\Users\admin\Desktop\email temp folder" & "\"
strFiles = Dir(strPath & "*.*")
Set objFolder = fso.GetFolder(strPath)
For Each objFile In objFolder.Files
If i = 0 Then
Set FileItemToUse = objFile // error: type mismatch
End If
Next objFile
With FileItemToUse
.ReplyAll
.BCC = ""
.Subject = "Hi"
.HTMLBody = "testing"
.BodyFormat = olFormatHTML
.display
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
It means that objFile is not of type Outlook.MailItem as you declared on top of your code.
Relying on the fact that your email template will always be the first item in the Files collection of the folder is not really stable, as the file might change position (probably is already not there, since you get the type mismatch error - you're probably trying to cast another type into a variable that is supposed to be a Outlook.MailItem type).
My suggestion is to reference directly to the file object; which means, in your code:
Set objFile = fso.GetFile("C:\...\mytemplate.msg")
and keep on running the code without the need to neither getFolder() nor looping For Each objFile in the Files collection, hoping that your file will be the first one.
However, best way to understand these kind of errors is to run the code in debug mode (press F8 and run line by line) and, by adding some watchers, figuring out what is what at run-time.
The Outlook object model doesn't provide any direct methods for opening .msg files on the disk. However, you can use the following workarounds to get the job done:
The CreateItemFromTemplate method of the Application class which allows to create a new Microsoft Outlook item from an Outlook template (.oft) or just a message file (.msg) and returns the new item. See How To: Create a new Outlook message based on a template for more information.
Use the ShellExecute method to open the file programmatically. Be aware, only one instance of the Outlook Application can be run at the same time. Thus, the message file will be opened in a new inspector window.
Sub CreateFromTemplate()
Dim MyItem As Outlook.MailItem
Set MyItem = Application.CreateItemFromTemplate("D:\message.msg")
MyItem.Display
End Sub

Resources