I need to use the Snipping Tool to capture a few screenshots, then copy & paste it into my Outlook Email template.
After I paste the pictures into the Email template, I want the images to change to a width of 9cm (255 ps) in a click of a button. The codes behind the button will run on the current item open.
That is, the code will have to run through the current item that is open and identify the image object, and run the codes to change the width of the image (with aspect ratio turned on).
I have done a little coding as shown below but I can't make it run. Can anyone help me on this?
p.s. I did a search and figured that ShapeRange only apply for Word, Powerpoint, Excel, Project, etc.
Option Explicit
Sub ChangeWidth()
Dim objApp As Outlook.Application
Dim objItem As Outlook.MailItem
Dim OrigShape As ShapeRange
Dim image As Object
Set objApp = Application
Set objItem = objApp.ActiveInspector.CurrentItem
objItem.ShapeRange.LockAspectRatio = msoTrue
objItem.ShapeRange.Width = 255.1181103
End Sub
You need to use InlineShapes :
Option Explicit
Sub ChangeWidth()
Dim objApp As Outlook.Application
Dim objItem As Outlook.MailItem
Dim iShape As InlineShape
Dim image As Object
Set objApp = Application
Set objItem = objApp.ActiveInspector.CurrentItem
For Each shp In objItem.InlineShapes
If shp.HasPicture Then
shp.LockAspectRatio = msoTrue
'shp.ScaleHeight = 150
'shp.ScaleWidth = 150
'or
shp.Width = 255.1181103
End If
Next
End Sub
Related
I'm trying to create a macro in Outlook to allow me to select text and convert that text to 'code' (Courier New, black). I'm using Outlook for Microsoft 365 which (I think) uses the Word editor...
I've copied some code I found in another answer and tweaked it, but no dice, and I fear I'm missing something obvious.
Public Sub FormatSelectedText()
Dim objItem As Object
Dim objInsp As Outlook.Inspector
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection
On Error Resume Next
Set objItem = Application.ActiveInspector.CurrentItem
If Not objItem Is Nothing Then
If objItem.Class = olMail Then
Set objInsp = objItem.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
With objSel
.Font.Name = "Courier New"
.Font.Color = RGB(0, 0, 0)
End With
End If
End If
End If
End Sub
I'm not a VBA guy, so it's likely something obvious :) I'm not even sure if it's a problem with the code or with the general macro support.
FWIW, in the past I wrote a separate VBA script to throw a warning message when I send an email to multiple people with different email domains (to avoid accidental data cross-sharing) which works fine, so I know a little bit...
To be clearer, I have added this code into a macro within the ThisOutlookSession object
I then open a new email and add some random text, select some of the text and run the macro, but the text in the email body doesn't change.
The code works correctly. You just need to add a COM reference to the Word object model to be able to use the Word object model in Outlook VBA macros.
In VBA editor window, click the “Tools” button in the menu bar.
Then, from the drop down list, select the “References” option.
The “References – Project 1” dialog box will display.
In this dialog box, you can pull the scrolling bar down until you locate what you need, in your case it is “Microsoft Word 16.0 Object Library”.
Mark the checkbox in front of the required entry and click “OK”.
Now you have added the Word object library reference successfully.
I use Outlook 365 on windows 10.
There are three calendars in the "My Calendars" group.
I would like to show all calendars at startup with the default calendar, Calendar 1, active using VBA.
To do this, I use the following VBA code, but there are two problems.
One problem is that a part of the code is redundant, which makes it time-consuming.
By default, only Calendar1 in My Calendars group is visible after startup.
To show all calendars, the code makes Calendar2 and Calendar3 visible.
After running these commands, Calendar3 is active.
To activate Calendar1 after startup, the code makes Calendar1 invisible and then visible.
I think, instead of this, it's an efficient way to use the command corresponding to check the checkbox of "My Calendars" in the navigation pane.
But I don't know how to do this.
The other problem is that, after startup using this macro, I can't switch day view and month view by shortcut keys, Cntl+Alt+1 and Cntl+Alt+2.
I think the way to check the check of "My Calendars" solves this problem
because I can switch these views by the shortcut keys when I manually check the checkbox.
So could you tell me the way to solve these problems?
Thank you in advance.
Private WithEvents g_Items As Outlook.Items
Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Set Ns = Application.GetNamespace("MAPI")
Set g_Items = Ns.GetDefaultFolder(olFolderCalendar).Items
setupInitialDisplayCalendars
End Sub
Public Sub setupInitialDisplayCalendars()
Dim navModCal As CalendarModule
Dim navGroup As NavigationGroup
Set navModCal = ActiveExplorer.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
Set navGroup = navModCal.NavigationGroups.Item("My Calendars")
If Not (navGroup Is Nothing) Then
navGroup.NavigationFolders.Item("Calendar2").IsSelected = True
navGroup.NavigationFolders.Item("Calendar3").IsSelected = True
navGroup.NavigationFolders.Item("Calendar1").IsSelected = False
navGroup.NavigationFolders.Item("Calendar1").IsSelected = True
End If
End Sub
You can use the NavigationFolders object can be used to display calendars listed on the navigation page in Outlook.
Sub SelectCalendars()
Dim objPane As Outlook.NavigationPane
Dim objModule As Outlook.CalendarModule
Dim objGroup As Outlook.NavigationGroup
Dim objNavFolder As Outlook.NavigationFolder
Dim objCalendar As Folder
Dim objFolder As Folder
Dim i As Integer
Set Application.ActiveExplorer.CurrentFolder = Session.GetDefaultFolder(olFolderCalendar)
DoEvents
Set objCalendar = Session.GetDefaultFolder(olFolderCalendar)
Set objPane = Application.ActiveExplorer.NavigationPane
Set objModule = objPane.Modules.GetNavigationModule(olModuleCalendar)
With objModule.NavigationGroups
Set objGroup = .GetDefaultNavigationGroup(olMyFoldersGroup)
End With
For i = 1 To objGroup.NavigationFolders.Count
Set objNavFolder = objGroup.NavigationFolders.Item(i)
Select Case i
' Enter the calendar index numbers you want to open
Case 1, 3, 4
objNavFolder.IsSelected = True
' Set to True to open side by side
objNavFolder.IsSideBySide = False
Case Else
objNavFolder.IsSelected = False
End Select
Next
' set the view here
Set objPane = Nothing
Set objModule = Nothing
Set objGroup = Nothing
Set objNavFolder = Nothing
Set objCalendar = Nothing
Set objFolder = Nothing
End Sub
To change calendar folder view (day/week/month) you can use the view object:
Dim objViews As Views
Dim objView As View
Set objViews = Application.ActiveExplorer.CurrentFolder.Views
Set objView = objViews.Item("Calendar")
With objView
' Set the calendar view to show a
' single day.
.CalendarViewMode = olCalendarViewDay
End With
objView.Apply
The CalendarView.CalendarViewMode property returns or sets an OlCalendarViewMode that determines the current view mode of the CalendarView object.
I am attempting to add convenience when adding notes to emails in Outlook.
My plan is to take my current procedure, which adds the notes to the selected email (as an attachment), and have it call a procedure which will set a UserProperty on the MailItem object so that I can easily see which emails have notes attached by adding a custom column to my email list view.
From scouring the internet I have pieced together the following.
Option Explicit
Public Sub MarkHasNote()
Dim Selection As Outlook.Selection
Dim UserDefinedFieldName As String
Dim objProperty As Outlook.UserProperty
Dim objItem As MailItem
UserDefinedFieldName = "Note"
Set objItem = GetCurrentItem()
Set objProperty = objItem.UserProperties.Add(UserDefinedFieldName, Outlook.OlUserPropertyType.olYesNo, olFormatYesNoIcon)
objProperty.Value = True
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
Set objApp = Nothing
End Function
I have set a breakpoint and checked the UserProperties of the MailItem. I see that the details are there and the value is set to "True". However, the email does not show the Yes/No icon in the "Note" column of the email pane of Outlook.
How do I get Outlook to show my user defined property value in the email pane when I add the column to the view?
A save is required for a selection. An Inspector item prompts for a save.
Private Sub MarkHasNote_DisplayTest()
' Add the UserProperty column with Field Chooser
' You can view the value toggling when you run through the code
Dim Selection As Selection
Dim UserDefinedFieldName As String
Dim objProperty As UserProperty
Dim objItem As mailItem
UserDefinedFieldName = "NoteTest"
Set objItem = GetCurrentItem()
Set objProperty = objItem.UserProperties.Add(UserDefinedFieldName, Outlook.OlUserPropertyType.olYesNo, olFormatYesNoIcon)
objProperty.Value = Not objProperty.Value
' Required for an explorer selection
objItem.Save
' For an inspector item there would be a prompt to save
' if not already done in the code
End Sub
Please advise me on parts of this or the whole thing if possible. I basically have an email every morning with 5-8 links to reports (on Sharepoint) and have to click each one, which then opens an excel document with the report, click refresh all, save then go back to outlook and click the next link. Is there a way to open the first link in Outlook, go to excel refresh all, save, then go back to Outlook and open the next link and repeat until all links have been pressed in VBA? Any and all help is greatly appreciated, Thank you.
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
Set objApp = Nothing
End Function
Sub Hyperlink(itm As MailItem)
Dim bodyString As String
Dim bodyStringSplitLine
Dim bodyStringSplitWord
Dim splitLine
Dim splitWord
bodyString = itm.Body
bodyStringSplitLine = Split(bodyString, vbCrLf)
For Each splitLine In bodyStringSplitLine
bodyStringSplitWord = Split(splitLine, " ")
For Each splitWord In bodyStringSplitWord
splitWord.Hyperlink.Select
Next
Next
Set itm = Nothing
End Sub
Sub test()
Dim currItem As MailItem
Set currItem = GetCurrentItem
Hyperlink currItem
End Sub
This is what I have come up with so far. Definitely contains errors. I just run the sub test() in the end.
There is a .Follow in Word.
Sub Hyperlink(itm As mailitem)
Dim oDoc As Object
Dim h As Hyperlink
If itm.GetInspector.EditorType = olEditorWord Then
Set oDoc = itm.GetInspector.WordEditor
For Each h In oDoc.Hyperlinks
Debug.Print h.Name
If Right(h.Name, 5) = ".xlsx" Then
h.Follow
End If
Next
End If
Set oDoc = Nothing
End Sub
You can handle the NewMailEx event of the Application class to handle all incoming emails. Then in the event handler you can parse the HTMLBody property value and extract links. Then you can do whatever you need with links - open them in the browser and etc.
I'd recommend starting from the Getting Started with VBA in Outlook 2010 article in MSDN. Then you may find a lot of HOWTO articles in the Concepts (Outlook 2013 developer reference) section.
Your problem is a bit too large, and although not too difficult, it involves multiple object library references (Regular Expressions, Internet Explorer, Excel). It is unlikely you that you will get a full solution to your problem. VBA is a really powerful and cool scripting language and not too difficult to learn. I highly recommend you divide your problem into smaller tasks, and try to work each task separately and come back with more specific questions.
How do I automatically send out multiple (currently visible) draft items with VBA?
Please help, thank you.
Edit: It's a tough case, none of the items are in the drafts folder yet. These are generated emails that are on your screen, waiting to be sent.
Edit2: nvm, it's not going to help anyway. My script creates approximately 500 emails, and displaying the first 100 causes out of memory error. I opted to auto send them without displaying (it breaks the layout this way, but it's my only option for now.)
It just so happens that I ran into the same issue before and have code handy. If you're not already in Outlook, you will need to add a reference in the VBA IDE, Tools ---> References... and check the box next to "Microsoft Outlook 14.0 Object Library".
Dim oFolder As Folder
Dim oNS As NameSpace
Dim olMail As MailItem
If (MsgBox("Are you sure you want to send ALL EMAILS IN YOUR DRAFTS FOLDER?", vbYesNo + vbCritical, "WARNING: THIS WILL SEND ALL DRAFTS")) = vbYes Then
Set oNS = Outlook.Application.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderDrafts)
For i = 1 To oFolder.Items.Count
oFolder.Items(1).Send
Next
End If
Set oNS = Nothing
Here's some code. Replace Your Name in myFolders("Mailbox - Your Name") with your actual name as it appears in the mailbox.
Public Sub EmailOutlookDraftsMessages()
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 in.
'Setup Outlook
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
'Set Draft Folder.
Set myDraftsFolder = myFolders("Mailbox - Your Name").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
Source Code adapted from this Question's answer.