excel vba - open outlook msg file then save as draft - excel

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

Related

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

Opening an Outlook .msg file with Excel VBA

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.

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

Extract Outlook body to Excel VBA

after searching multiple things, and getting errors
How do I upon pressing "f5" in a vba script copy the body of an email into an excel sheet /csv
where every line = a new cell below.
Thanks
Sorry, this is causing me nothing but trouble.
What I have tried so far
http://smallbusiness.chron.com/export-outlook-emails-excel-spreadsheets-41441.html
How to copy Outlook mail message into excel using VBA or Macros
http://www.vbforums.com/showthread.php?415518-RESOLVED-outlook-the-macros-in-this-project-are-disabled
http://www.ozgrid.com/forum/showthread.php?t=181512
and a few more, last year.
This will work for you. we are basically splitting the email body into an array based on a new line. Notice that this will yield blank cells if you had a blank line in the email body.
Public Sub SplitEmail() ' Ensure reference to Word and Excel Object model is set
Dim rpl As Outlook.MailItem
Dim itm As Object
Set itm = GetCurrentItem()
If Not itm Is Nothing Then
Set rpl = itm.Reply
rpl.BodyFormat = olFormatHTML
'rpl.Display
End If
Dim objDoc As Word.Document
Set objDoc = rpl.GetInspector.WordEditor
Dim txt As String
txt = objDoc.Content.text
Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.application")
xlApp.Visible = True
Dim wb As Excel.Workbook
Set wb = xlApp.Workbooks.Add
Dim i As Long
For i = LBound(Split(txt, Chr(13)), 1) To UBound(Split(txt, Chr(13)), 1)
wb.Worksheets(1).Range("A" & i + 1).Value = Split(txt, Chr(13))(i)
Next i
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
GetCurrentItem.UnRead = False
Set objApp = Nothing
End Function
The Outlook object model doesn't recognize lines in the body. You can try to resize any inspector window in Outlook and see how the body lines are changed.
Anyway, you may try to use the Word object model to get the exact lines. Outlook uses Word as an email editor. The WordEditor property of the Inspector class returns an instance of the Document class which represents the message body. You can read more about all possible ways in the Chapter 17: Working with Item Bodies article.
The How to automate Microsoft Excel from Visual Basic article explains how to automate Excel from any external application.

Pasting formatted Excel range into Outlook message

I would like to paste a range of formatted Excel cells into an Outlook message.
The following code (that I lifted from various sources), runs without error and sends an empty message.
Sub SendMessage(SubjectText As String, Importance As OlImportance)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim iAddr As Integer, Col As Integer, SendLink As Boolean
'Dim Doc As Word.Document, wdRn As Word.Range
Dim Doc As Object, wdRn As Object
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
Set Doc = objOutlookMsg.GetInspector.WordEditor
'Set Doc = objOutlookMsg.ActiveInspector.WordEditor
Set wdRn = Doc.Range
wdRn.Paste
Set objOutlookRecip = objOutlookMsg.Recipients.Add("MyAddress#MyDomain.com")
objOutlookRecip.Type = 1
objOutlookMsg.Subject = SubjectText
objOutlookMsg.Importance = Importance
With objOutlookMsg
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
' Set the Subject, Body, and Importance of the message.
'.Subject = "Coverage Requests"
'objDrafts.GetFromClipboard
Next
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
I think you need to call .Save on your Mail Item (objOutlookMsg) after you've made all the changes.
Put .Display before .Send,
Simple but Quick fix, your problem is the email is not refreshing with the pasted contents before it sends, forcing it to Display first gives it time...
Also make sure you have another macro which runs before this to Copy the Range into your clipboard...
There is a button in excel to do this, "Send to mail recipent" its not normally on the ribbon.
You can also use the simple mapi built into office using the MailEnvelope in VBA
.. a good article on what you are trying to do http://www.rondebruin.nl/mail/folder3/mail4.htm

Resources