I'm making a word macro that runs on Document_Close(). I want the macro to open a outlook- "new message" window with no recipient, no subject, just a floder attached including some saved PDF's of the word template.
I've tried to do it this way:
Sub Document_Close()
ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
.Subject = "New subject"
.Attachments.Add Source:="C:\temp\PDFSaves", Type:=olByValue
End With
End Sub
I know it opens an instance, because I printed it once, although I'd like it to pop UP on te screen so that i can manually enter recipient etc, and confirm that the correct PDF-folder was attached.
It would be nice if there was a oIten.Visible command...
Use the MailItem.Display Method.
oItem.Display
Related
We are updating mails from the drafts folder and sending them a few times a day.
I want to open a selected mail resend it save it so it goes back to drafts and then close it.
I tried below
Sub DRAFT()
Dim myItem As Outlook.MailItem
Dim objInsp As Outlook.Inspector
Dim objActionsMenu As Office.CommandBarControl
Dim olResendMsg As Outlook.MailItem
' get current item & open if needed
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set myItem = Application.ActiveExplorer.Selection.Item(1)
myItem.Display
Case "Inspector"
Set myItem = Application.ActiveInspector.CurrentItem
Case Else
End Select
On Error GoTo 0
If myItem Is Nothing Then
MsgBox "Could not use current item. Please select or open a single email.", _
vbInformation
GoTo exitproc
End If
' run the resend command
Set objInsp = myItem.GetInspector
objInsp.CommandBars.ExecuteMso ("ResendThisMessage")
' save orig email
myItem.Save
' close orig email
myItem.Close
exitproc:
Set myItem = Nothing
Set objInsp = Nothing
Set objActionsMenu = Nothing
Set olResendMsg = Nothing
End Sub
You need to pass a OlInspectorClose enumeration value to the MailItem.Close method. It indicates the close behavior, i.e. the save mode. If the item displayed within the inspector has not been changed, this argument has no effect.
Name Value Description
olDiscard 1 Changes to the document are discarded.
olPromptForSave 2 User is prompted to save documents.
olSave 0 Documents are saved.
So, your code should like that:
' close orig email
myItem.Close olSave
Instead of executing the ribbon control programmatically using the CommandBars.ExecuteMso method you may try to create a cope of the source item and then send it.
The ExecuteMso method is useful in cases where there is no object model for a particular command. Works on controls that are built-in buttons, toggleButtons and splitButtons. On failure it returns E_InvalidArg for an invalid idMso, and E_Fail for controls that are not enabled or not visible.
Instead, you may use the MailItem.Copy method which creates another instance of an object.
Sub CopyItem()
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myNewFolder As Outlook.Folder
Dim myItem As Outlook.MailItem
Dim myCopiedItem As Outlook.MailItem
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myNewFolder = myFolder.Folders.Add("Saved Mail", olFolderDrafts)
Set myItem = Application.CreateItem(olMailItem)
myItem.Subject = "Speeches"
Set myCopiedItem = myItem.Copy
myCopiedItem.To = "email#address.com"
myCopiedItem.Send()
End Sub
Although there is a mistake in myItem.Close, you cannot resend mail that has not been sent.
Option Explicit
Sub SendMailBasedOnPermanentDraft()
Dim myItem As MailItem
Dim objInsp As Inspector
Dim myCopyOfUnsentItemInDrafts As MailItem
' get current item & open if needed
On Error Resume Next
Select Case TypeName(ActiveWindow)
Case "Explorer"
Set myItem = ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set myItem = ActiveInspector.CurrentItem
Case Else
End Select
On Error GoTo 0
If myItem Is Nothing Then
MsgBox "Could not use current item. Please select or open a single email.", vbInformation
GoTo exitProc
End If
If myItem.Sent = False Then
Set myCopyOfUnsentItemInDrafts = myItem.copy
With myCopyOfUnsentItemInDrafts
.Subject = "Copied " & Now & ": " & myItem.Subject
.Save
.Display ' change to .Send
End With
Else
MsgBox "Select or open a single unsent email.", vbInformation
End If
exitProc:
Set myItem = Nothing
Set objInsp = Nothing
Set myCopyOfUnsentItemInDrafts = Nothing
End Sub
All my emails have this sentence added " this email has come from an external source. Do not click on links or open attachments unless you recognise the sender."
I would like to delete it.; I have made this macro but it does not work. Nothing happens. Other macros do work in outlook session, so it is not a security issue. I would expect the macro to take a minute or so for 100s of emails to search. but nothing happens at all. Can you help ?
Sub RemoveExpressionFOLDER()
Dim outNS As Outlook.NameSpace
Dim outFldr As Outlook.Folder
Dim outMailItems As Outlook.Items
'Dim outMailItem As Outlook.MailItem
Dim outMailItem As Object
Dim myinspector As Outlook.Inspector
Set outNS = Application.GetNamespace("MAPI")
Set outFldr = Application.ActiveExplorer.CurrentFolder
Set myinspector = Application.ActiveInspector
Set outMailItems = outFldr.Items
K = outFldr.Items.Count
'MsgBox (K)
For i = 1 To K
If outMailItems(i).Class <> olMail Then GoTo 20
outMailItems(i).Display
'outMailItems(i).UnRead = True
outMailItems(i).Body = Replace(outMailItems(i).Body, "THINK SECURE. This
email has come from an external source. Do not click on links or open
attachments unless you recognise the sender.", "")
'outMailItems(i).HTMLBody = Replace(outMailItems(i).HTMLBody, "THINK SECURE.
This email has come from an external source. Do not click on links or open
attachments unless you recognise the sender.", "")
outMailItems(i).Save
Set myinspector = Application.ActiveInspector
Set outMailItems(i) = myinspector.CurrentItem
outMailItems(i).Close olSave
20 Next i
MsgBox ("cleaned ")
Set outMailItems = Nothing
Set outFldr = Nothing
Set outNS = Nothing
End Sub
There is no need to open the mailitems.
Option Explicit
Sub RemoveExpressionFOLDER()
Dim outFldr As folder
Dim outItems As Items
Dim outMailItem As MailItem
Dim i As Long
Dim cleanCount As Long
Set outFldr = ActiveExplorer.CurrentFolder
Set outItems = outFldr.Items
For i = 1 To outItems.Count
If outItems(i).Class = olMail Then
Set outMailItem = outItems(i)
With outMailItem
'Debug.Print .Subject
If InStr(.Body, "THINK SECURE. This email has come from an external source. Do not click on links or open attachments unless you recognise the sender.") Then
If .BodyFormat = olFormatHTML Then
.HTMLBody = Replace(.HTMLBody, "THINK SECURE. This email has come from an external source. Do not click on links or open attachments unless you recognise the sender.", "")
Else
.Body = Replace(.Body, "THINK SECURE. This email has come from an external source. Do not click on links or open attachments unless you recognise the sender.", "")
End If
.SAVE
cleanCount = cleanCount + 1
End If
End With
End If
Next i
MsgBox (cleanCount & " mailitems cleaned.")
End Sub
When I send mail free from attachment, works truly.
But when I using the .Attachments.Add ActiveWorkbook.FullName parameter, it does not send and been pending to opening Outlook.
I want send mails when outlook is closed.
I'm using below code:
Sub SendMail()
Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem
Set OutlookApp = New Outlook.Application
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
With OutlookMail
.To = "address#domain.com"
.CC = ""
.BCC = ""
.Subject = "M"
.BodyFormat = olFormatHTML
.HTMLBody = "Hi, <p> I'm sending this message from Excel using VBA.</p>Please find <strong> M</strong> in life."
.Attachments.Add ActiveWorkbook.FullName
.DeferredDeliveryTime = DateAdd("n", 1, Now)
.Importance = olImportanceHigh
.ReadReceiptRequested = True
.Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
About .DeferredDeliveryTime = DateAdd("n", 1, Now): I want the email have send 1 minutes after running the macro.
Regards.
Reasons for why this question is unique:
StackowerflowQuestion: Here the problem is solved in my above code and the remained problem is sending attachment that I focused on here. and the appropriated answer is what I accent about is Outlook is closed.
Update
Another symptom is when I running above code an temporal Icon will shown in the try system with a popup message: "another program is using outlook. to disconnect program and exit outlook...".
Please also consider this, if important.
Please note that the problem is sending attachment.
With above code, the problem of sending email when outlook is closed was solved. (that mentioned in similar question)
So the remained problem is sending attachment in this case (Outlook is closed).
Sorry, I misinterpreted your question just now. With reference to here, you need to add the following code.
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application")
End If
On Error Goto 0
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = "address#domain.com" ' continue from here
I am trying to open Outlook when a button is clicked in MS Access, I have the following code which I have gathered online and after tinkering with it it is still not working. Here is my code:
Private Sub Command56_Click()
Dim obj
On Error Resume Next
Set obj = GetObject(, "Outlook.Application")
On Error GoTo 0
If obj Is Nothing Then Set obj = CreateObject("Outlook.Application")
End Sub
Does anyone have any suggestions?
No need to call GetObject. If Outlook is loaded, it will create a reference to it and if not, it will be loaded. It will not create a new instance though.
Private Sub Command56_Click()
Dim obj As Object
Set obj = CreateObject("Outlook.Application")
obj.Visible = True
'do work
obj.Quit '<-- This will close Outlook
Set obj = Nothing
End Sub
I have been using this procedure:
Private Sub OpenOutlook(emailAddress As String)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Set the Subject, Body, and Importance of the message.
.Subject = "ISF"
.Body = "This is the body of the message." & vbCrLf & vbCrLf
.Recipients.Add (emailAddress)
' Add attachments to the message.
Set objOutlookAttach = .Attachments.Add("\\sql\images\" & Forms![WebQADocumentReview].FileName)
.Display
End With
Set objOutlook = Nothing
End Sub
But you can’t use similar code with Outlook due to how Outlook opens which is quite different from other Office products. Sometimes it is important to know that Outlook is open, for example to be sure that your mails created with VBA code are sent and not waiting in your outbox.
The code below is created by MVP Ben Clothier and can either retrieve an open instance of Outlook or open Outlook if it is closed. This uses a ‘self-healing object’ approach for returning an instance of Outlook.
https://www.rondebruin.nl/win/s1/outlook/openclose.htm
Add this to the Declarations
Dim g_olApp As Object
Create the below Subroutine
Private Sub fireOutlook()
Dim olShellVal As Long
On Error GoTo FIREOUTLOOK_ERR
Set g_olApp = GetObject(, "Outlook.Application") ' If outlook is open will create obj
' If closed this will goto the error handler and then resume
If g_olApp Is Nothing Then ' This checks if object was created
olShellVal = Shell("OUTLOOK", vbNormalNoFocus) ' Opens Outlook
Set g_olApp = CreateObject("Outlook.Application") ' Creates the Object
End If
FIREOUTLOOK_EXIT:
Exit Sub
FIREOUTLOOK_ERR:
If g_olApp Is Nothing Then
Err.Clear
Resume Next
Else
MsgBox Err.Description, , "Error Number: " & Err.Number
End If
GoTo FIREOUTLOOK_EXIT
End Sub
Once this is complete the global object can be used in any code involving outlook just make sure to call the fireOutlook subroutine first.
I get a lot of spam messages on my work Outlook 2010 account. I am provided with our spam blocker address to forward the spam (as an attachment) to.
I'd like to click on an icon on the ribbon (I already have this) and have VBA code run that takes the current message, attaches it to a new message, adds an address to the new message, sends the new message and then deletes the original message. (Deleting can be either putting the message in the "Deleted Items" folder or permanently deleting it.)
SOLVED!!!!
Here is code that does exactly what I want. I found it on the net and modified it to meet my needs.
Sub ForwardAndDeleteSpam()
'
' Takes currently highlighted e-mail, sends it as an attachment to
' spamfilter and then deletes the message.
'
Set objItem = GetCurrentItem()
Set objMsg = Application.CreateItem(olMailItem)
With objMsg
.Attachments.Add objItem, olEmbeddeditem
.Subject = "SPAM"
.To = "spamfilter#schools.nyc.gov"
.Send
End With
objItem.Delete
Set objItem = Nothing
Set objMsg = Nothing
End Sub
Function GetCurrentItem() As Object
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = Application.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = Application.ActiveInspector.CurrentItem
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select
Set objApp = Nothing
End Function
You can use this to go through a selection of emails, rather than just one by adapting the code as follows
Sub ForwardSpamToNetworkBox()
On Error Resume Next
Dim objItem As Outlook.MailItem
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No item selected")
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
Set objMsg = Application.CreateItem(olMailItem)
With objMsg
.Attachments.Add objItem, olEmbeddeditem
.Subject = "SPAM"
.To = "spam#host.co.uk"
.Send
End With
objItem.Delete
Next
Set objItem = Nothing
Set objMsg = Nothing
End Sub
This was created with info from http://jmerrell.com/2011/05/21/outlook-macros-move-email
Ideally, instead of deleting, I'd move it to a subfolder called "Submitted" but I can't get that to work in Public Folders