I receive emails that contain a link. That link does not work since I am not on that company's network. I can change part of the link for external use to get it to work.
For example the email has this link:
https://ipdms.web.companyname.com/ipdms/itemlocation
I change it to:
https://companyVPN.companyname.com/ipdms/itemlocation
I was able to create a script but I need to open the email, run the macro, and then hit save on the email.
Sub Change2VPN()
Application.ActiveInspector.CurrentItem.body = _
Replace(Application.ActiveInspector.CurrentItem.body, "ipdms.web", "companyVPN")
End Sub
I searched but have not been able to get anything to work. Is there a way I can either accomplish this on all items in a folder and save the email where it is or at least do it from the reading pane?
I can add the macro button to the ribbon.
I cannot run scripts as a rule on incoming emails due to corporate policies.
Basically you need to get the currently selected folder where a ribbon button was clicked and iterate over all items in the folder to get the job done:
Sub Change2VPN()
Dim olFolder As Outlook.Folder
Dim Item As Object
Dim explorer as Outlook.Explorer
Set explorer = Application.ActiveExplorer()
Set olFolder = explorer.CurrentFolder
For Each Item In olFolder.Items
If TypeOf Item Is Outlook.MailItem Then
Dim oMail As Outlook.MailItem: Set oMail = Item
oMail.HTMLBody = Replace(oMail.HTMLBody, "ipdms.web", "companyVPN")
oMail.Save()
End If
Next
End Sub
Related
I would like to automatically print emails to PDF from outlook.
I haven't found a way to automate the print dialogue. There are a couple other threads dealing with this same issue in Outlook VBA, but no clear solution (I thought it would be simple!)
For example, I have a rule in outlook that automatically moves receipts to a specific folder. I'd like to automatically print these to PDF. I've tried to accomplish this by...
For Loop: Go through each unread item in the specified folder
Print: MailItem.Printout Method
Print Dialogue: Input path and filename and click OK. I haven't found any means of automating this process
Sub PrintReceipts()
'==============================================
'Declare variables, set namespace, define outlook folder (example names used below)
'==============================================
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim msg As Outlook.MailItem
Dim Path As String
Dim Name As String
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFldr = objNS.GetDefaultFolder(olFolderInbox).Folders("subfolder 1").Folders("subfolder 2")
'==============================================
'For each unread message save to Path with Name and mark as Read (path is just an example)
'==============================================
For Each msg In olFldr.Items
If msg.UnRead Then
Path = "C:\Users\User\Desktop\"
Name = msg.Subject & ".pdf"
msg.PrintOut
'=================================================
'Here is where I get lost.
'Print Dialogue opens. I have tried SendKeys but it does not work
'=================================================
msg.UnRead = False
End If
Next
End Sub
Alternative: I am wondering if I can do the following...
Save for Word: MailItem.SaveAs, to save the item as an .MHT
Open Word: Somehow open Word and apply ActiveDocument.ExportAsFixedFormat to export as PDF
Close Word and go back to Outlook
I hope someone may have an idea!
First of all, iterating over all items in the folder is not really a good idea in Outlook. Instead, you need to use the Find/FindNext or Restrict methods of the Items class. These methods allow getting items that correspond to your search criteria only. Read more about these methods in the following articles:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder
To save the message body using the PDF file format there is no need to use the SaveAs method of the MailItem class. The WordEditor property of the Inspector class returns an instance of the Word Document class which represents the message body. You can call the ExportAsFixedFormat method of the Document class directly from Outlook avoiding any disk operations.
Dim objDoc As Object, objInspector As Object
Set objInspector = myItem.GetInspector
Set objDoc = objInspector.WordEditor
objDoc.ExportAsFixedFormat folderPath & fileName & ".pdf", 17
Set objInspector = Nothing
Set objDoc = Nothing
See Chapter 17: Working with Item Bodies for more information.
I have a script to process emails. User's can kick this script off by using a form.
I want them to only be able to use the form if they have an email open and in focus. So how can I check that the CurrentItem in:
objApp.ActiveInspector.CurrentItem
Is an email and is not another open window?
To work with mail item that is open and has focus, use ActiveInspector method
Example blew to print subject if Item is Mailitem
Option Explicit
Sub Item_Info()
Dim Active_Item As Object
Set Active_Item = Application.ActiveInspector.CurrentItem
If TypeOf Active_Item Is Outlook.MailItem Then
Debug.Print Active_Item.Subject
End If
End Sub
I have a procedure in Outlook that sends all the saved messages in Drafts folder.
Below is the code:
Public Sub SendMail()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olDraft As Outlook.MAPIFolder
Dim strfoldername As String
Dim i As Integer
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(olFolderInbox)
strfoldername = olFolder.Parent
Set olDraft = olNS.Folders(strfoldername).Folders("Drafts")
If olDraft.Items.Count <> 0 Then
For i = olDraft.Items.Count To 1 Step -1
olDraft.Items.Item(i).Send
Next
End If
End Sub
Above code works fine.
Question:
I want to use Task Scheduler to fire this procedure as a specified time.
1. Where will I put the procedure in Outlook, Module or ThisOutlookSession?
2. I am not good in vbscript so I also don't know how to code it to call the Outlook Procedure. I've done calling Excel Procedure but Outlook doesn't support .Run property.
So this doesn't work:
Dim olApp
Set olApp = CreateObject("Outlook.Application")
olApp.Run "ProcedureName"
Set olApp = Nothing
I've also read about the Session.Logon like this:
Dim olApp
Set olApp = CreateObject("Outlook.Application")
olApp.Session.Logon
olApp.ProcedureName
Set olApp = Nothing
But it throws up error saying object ProcedureName is not supported.
Hope somebody can shed some light.
SOLUTION:
Ok, I've figured out 2 work around to Avoid or get pass this pop-up.
1st one: is as KazJaw Pointed out.
Assuming you have another program (eg. Excel, VBScript) which includes sending of mail via Outlook in the procedure.
Instead of using .Send, just .Save the mail.
It will be saved in the Outlook's Draft folder.
Then using below code, send the draft which fires using Outlook Task Reminder.
Option Explicit
Private WithEvents my_reminder As Outlook.Reminders
Private Sub Application_Reminder(ByVal Item As Object)
Dim myitem As TaskItem
If Item.Class = olTask Then 'This works the same as the next line but i prefer it since it automatically provides you the different item classes.
'If TypeName(Item) = "TaskItem" Then
Set my_reminder = Outlook.Reminders
Set myitem = Item
If myitem.Subject = "Send Draft" Then
Call SendMail
End If
End If
End Sub
Private Sub my_reminder_BeforeReminderShow(Cancel As Boolean)
Cancel = True
Set my_reminder = Nothing
End Sub
Above code fires when Task Reminder shows with a subject "Send Draft".
But, we don't want it showing since the whole point is just to call the SendMail procedure.
So we added a procedure that Cancels the display of reminder which is of olTask class or TaskItem Type.
This requires that Outlook is running of course.
You can keep it running 24 hours as i did or, create a VBscript that opens it to be scheduled via Task Scheduler.
2nd one: is to use API to programatically click on Allow button when the security pop-up appears.
Credits to SiddarthRout for the help.
Here is the LINK which will help you programmatically click on the Allow button.
Of course you have to tweak it a bit.
Tried & Tested!
Assuming that you have Outlook Application always running (according to comment below your question) you can do what you need in the following steps:
add a new task in Outlook, set subject to: "run macro YourMacroName" and set time (plus cycles) when your macro should start.
go to VBA Editor, open ThisOutlookSession module and add the following code inside (plus see the comments inside the code):
Private Sub Application_Reminder(ByVal Item As Object)
If TypeName(Item) = "TaskItem" Then
Dim myItem As TaskItem
Set myItem = Item
If myItem.Subject = "run macro YourMacroName" Then
Call YourMacroName '...your macro name here
End If
End If
End Sub
Where will I put the procedure in Outlook, Module or ThisOutlookSession?
Neither. Paste the below code in a Text File and save it as a .VBS file. Then call this VBS file from the Task Scheduler as shown HERE
Dim olApp, olNS, olFolder, olDraft, strfoldername, i
Set olApp = GetObject(, "Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(6)
strfoldername = olFolder.Parent
Set olDraft = olNS.Folders(strfoldername).Folders("Drafts")
If olDraft.Items.Count <> 0 Then
For i = olDraft.Items.Count To 1 Step -1
olDraft.Items.Item(i).Send
Next
End If
If you are using Outlook 2007 or newer I have found you can easily eliminate the security pop up you mentioned above when running your script by doing the following:
In Outlook 2007 Trust Center, go to Macro Security - Select "No security Check for macros"
In Outlook 2007 Trust Center, go to Programatic Access - Select "Never warn me abous suspicious activity.
Of course that technically leaves you open to the remote possibility for someone to email you some malicious email script or something of that nature I assume. I trust my company has that managed though and this works for me. I can use VBS scripts in Outlook, Access, Excel to send emails with no security pop up.
Another Option:
If you don't want to do that, another option that has worked well for me prior to this is here:
http://www.dimastr.com/redemption/objects.htm
Basically a dll redirect that does not include the popup. It leaves your other default security in place and you write \ call your VBA for it and send mail without the secutity pop-ups.
Good morning,
Using Outlook 2010 I compiled code to send all emails that were saved in a drafts folder of a given account. Now I've upgraded to Office 2013 I am getting an error... It is the .Send bit where it falls over and presents the error message:
"This method can't be used with an inline response mail item."
I am certain that there is a v simple method for sending drafts, but I have scoured the web and can't figure it as yet.
Public Sub SendDrafts()
Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder
'Send all items in the "Drafts" folder that have a "To" address filled
'Setup Outlook
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
'Set Draft Folder. This will need modification based on where it's
Set myDraftsFolder = myFolders("accounts#credec.co.uk").Folders("Drafts")
'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.count To 1 Step -1
'Check for "To" address and only send if "To" is filled in.
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) ] 0 Then
'Send Item
myDraftsFolder.Items.Item(lDraftItem).Send
End If
Next lDraftItem
'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub
I know this is old, but in case someone elses is looking for an answer:
"Active Inline Response" refers to a draft that is open in Outlook. So, when you are debugging, close the draft and flip back to a different message. Then see if your code will run.
I found that if you have clicked on the draft folder so that the Draft folder is active, then you get that error message, usually on the email in the folder that is highlighted.
SOLUTION: Click on any other folder, then run the code, should work, mine did!
I initially had this code running to save attachments from emails that come in. My code would loop through the entire folder and for any attachments that were there, it would save the attachment and remove it from the email. I had a rule in place to make the macro fire whenever the mail I wanted came in. However the attachment would never save down when the mail came. There were no errors, and debugging manually worked just fine. In addition, running the rule immediately afterwards by clicking the 'Run rules now' button would work just fine too. So after trying out a million different ways to save the attachments, I started getting really annoyed and set up a test to see what the hell outlook was doing. So here is the problem.
This is the outlook rule I have set up:
Apply this rule after the message arrives
from xxxxx
move it to the Macrotest folder
and run Project1.ThisOutlookSession.sayhi
I discovered though that what outlook does is fire the script Before it transfers the mail into the folder my macro looks in. Hence, it never finds the new file. Obviously then when its done the mail comes into the folder so when I run it manually it works just fine. So how can I fix the order that this rule comes in?
Public Sub sayhi(item As Outlook.MailItem)
Dim objNS As Outlook.NameSpace
Dim olfolder As Outlook.MAPIFolder
Dim msg As Outlook.MailItem
Set objNS = Application.GetNamespace("MAPI")
Set olfolder = objNS.GetDefaultFolder(olFolderInbox)
Set olsubfolder = olfolder.Folders("Macrotest")
Set oapp = CreateObject("Shell.Application")
For Each myitem In olsubfolder.Items
MsgBox "hellothere"
myitem.UnRead = False
Next
End Sub
The code processes the item you pass in (item As Outlook.MailItem)
Public Sub sayhi(item As Outlook.MailItem)
MsgBox "item Subject: " & item.Subject
End Sub
Process the attachments of "item", not all the mailitems in the folder.