Need a "fairly simple" Outlook 2010 Macro

Hi Experts,

As stated, I need a "fairly simple" Outlook 2010 Macro that will take the contents of the clipboard (usually a web page or portion thereof), Paste same into the Notes field of an Outlook Contact where the cursor presently resides, and then Change the Size of the Object pasted by changing the Height to 40% of the Original Picture Size while maintaining the "Lock Aspect Ratio" checked status as checked.

This is a process I use frequently as the pasted objects are mostly too large to see without scrolling.  

I have zero experience with Outlook macros but I can find a way to link same to a Toolbar/Ribbon if someone can assist with the code.  

Thanks for any assistance!

Jeff
LVL 2
Jeffrey SmithOwnerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Neil FlemingConsultant and developerCommented:
You can do this by accessing the "WordEditor" property of the contact .. that is the underlying instance of Microsoft Word that is embedded in Outlook.  In the Contact Item this equates to the contents of the Notes field.

Try the following code. It pastes the image at the end of the note, ie doesn't mess with existing contents.

For more flexibility (eg if you want to paste more than one image, set wrapping format etc). I would recommend adding Microsoft Word to the "Tools/References" section of your VBA editor and defining the "Objects" below as "Word.Document" , "Word.InlineShape" etc. That makes it easier to figure out what is going on. However, if this is all you need, it works.

You can attach the macro to a Quick Access toolbar button.


Sub autoPaste()
Dim oC As ContactItem
Dim ww As Object, oIL As Object, oSH As Object, oRR As Object

On Error GoTo errortrap
'get current item (will trigger error if not a contact)
Set oC = ActiveInspector.CurrentItem
'get the "Word inspector" for the item
Set ww = oC.GetInspector.WordEditor
'paste at end of note text range
Set oRR = ww.Range
'shrink to end
oRR.Start = oRR.End
'paste image
oRR.Paste
'set oIL to the last pasted image
Set oIL = ww.InlineShapes(ww.InlineShapes.Count)
'convert from "inLineshape" to "Shape"
Set oSH = oIL.ConvertToShape
'lock aspect ratio
oSH.LockAspectRatio = msoTrue
'scale to 40% relative to original
oSH.ScaleHeight 0.4, msoTrue
'set top and left
oSH.Top = 10
oSH.Left = 10
Exit Sub

errortrap:
'handle various errors
Select Case Err.Number
Case 13: MsgBox "Please open a Contact and try again"
Case 5941, 5855: MsgBox "Can't find picture in Notes"
Case Else: MsgBox ("An unknown error has occurred")
End Select
End Sub

Open in new window

0
Jeffrey SmithOwnerAuthor Commented:
Hi Neil & thanks for posting!

Well, this is pretty close and will provide some utility to me but ideally, I would like to be able to Insert/Paste the image at the location where the cursor presently resides when the macro is executed. As is, to re-locate it from the end of the Notes field to my preferred location is also a little strange:  Normally, I can just drag a pasted image to a given location and drop it where I want it and it is inserted at that spot.  However, the image pasted with this code doesn't do that; rather it just "floats" over the other content unless I insert enough blank lines to accommodate the image size.  I *suspect* that it due to this code:

convert from "inLineshape" to "Shape"

Open in new window


... but I'm not sure.  IF that is the cause, is it necessary to do this conversion?  And/or, is there a way around this issue so that the image is inserted at the cursor location?
0
Neil FlemingConsultant and developerCommented:
No, the conversion to Shape is not necessary. Sorry.. was adapting some other code.

This inserts a straightforward inlineShape at the cursor location, without modifying it.

Sub autoPaste()
Dim oC As ContactItem
Dim ww As Object, oIL As Object, oRR As Object

On Error GoTo errortrap
'get current item (will trigger error if not a contact)
Set oC = ActiveInspector.CurrentItem
'get the "Word inspector" for the item
Set ww = oC.GetInspector.WordEditor
'paste at end of note text range
Set oRR = ww.Application.Selection
'paste image
oRR.Paste
Set oIL = ww.InlineShapes(ww.InlineShapes.Count)
oIL.LockAspectRatio = msoTrue
oIL.ScaleHeight = 40
oIL.ScaleHeight = 40 'set top and left
Exit Sub

errortrap:
'handle various errors
Select Case Err.Number
Case 13: MsgBox "Please open a Contact and try again"
Case 5941, 5855: MsgBox "Can't find picture in Notes"
Case Else: MsgBox ("An unknown error has occurred")
End Select
End Sub

Open in new window

0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Neil FlemingConsultant and developerCommented:
Actually, if you have some text selected, it will paste the image in place of the selected text. So you may want to add the line
orr.collapse

Open in new window


to collapse the selection for safety reasons before the line
orr.paste

Open in new window

0
Neil FlemingConsultant and developerCommented:
Also I inadvertently put the ScaleHeight command in twice.

Here's the clean version, with the "collapse" command added
Sub autoPaste()
Dim oC As ContactItem
Dim ww As Object, oIL As Object, oRR As Object

On Error GoTo errortrap
'get current item (will trigger error if not a contact)
Set oC = ActiveInspector.CurrentItem
'get the "Word inspector" for the item
Set ww = oC.GetInspector.WordEditor
'paste at end of note text range
Set oRR = ww.Application.Selection
oRR.Collapse
'paste image
oRR.Paste
Set oIL = ww.InlineShapes(ww.InlineShapes.Count)
oIL.LockAspectRatio = msoTrue
oIL.ScaleHeight = 40

Exit Sub

errortrap:
'handle various errors
Select Case Err.Number
Case 13: MsgBox "Please open a Contact and try again"
Case 5941, 5855: MsgBox "Can't find picture in Notes"
Case Else: MsgBox ("An unknown error has occurred")
End Select
End Sub

Open in new window

0
Jeffrey SmithOwnerAuthor Commented:
Hi Neil,

That's much closer but I'm still getting inconsistent results:

1) If there are no other images existing in the Contact, it works as desired, pasting the image where the cursor is AND reducing the size to 40%
2) If there are other images existing in the Contact, the new image is pasted in the desired location but it is not reduced to 40% (also, there is no error)
3) If there is a Horizontal Line existing anywhere in the Contact, the image is pasted, but at 100% (no reduction) and it throws the following error:

VBA-Error-4693.jpg

Also, I note that the text to be replaced is not actually replaced when the image is pasted; however, that is not an issue for me as I would prefer it to not replace any existing text (or to have to remember to enter any bogus text).

Hope this is clear and there is a resolution available.

Thanks again,

Jeff
0
Neil FlemingConsultant and developerCommented:
No, the text highlighted would not be replaced. I made that change.

I'll look into the "horizontal line" excitement. It would have been helpful to know that you had a bunch of other stuff in the "notes" field already.
0
Jeffrey SmithOwnerAuthor Commented:
Sorry I didn't make that clear, Neil. It's kind of haphazard - some Contacts may have that other stuff, and others don't.
0
Neil FlemingConsultant and developerCommented:
No problem. I'd assumed Outlook was numbering its InlineShapes in the order they were added. It turns out they are re-numbered based on the order in which they appear in the Note, regardless of what was last added.

So whether the pasted shape was shrunk or not was dependent on whether it was the shape closest to the END of the text or not. Hence also the problem with the horizontal line. If the line was the last thing in the note, it was triggering an error, since it too is an "inline shape".

The code below deals with that by marking where the cursor is immediately before the paste, and shrinking the shape found at that point in the text.  That is, the correct shape.

Sub autoPaste()
Dim oC As ContactItem
Dim ww As Object, oIL As Object, oRR As Object
Dim iShapeStart

On Error GoTo errortrap
'get current Outlook item (will trigger error if item is not a contact)
Set oC = ActiveInspector.CurrentItem
'get the "Word inspector" for the item
Set ww = oC.GetInspector.WordEditor
'paste at start of current selection
Set oRR = ww.Application.Selection
'shrink selection to zero
oRR.Collapse
'note start point
iShapeStart = oRR.Start
'paste image
oRR.Paste
'loop through all inline shapes and stop at just-pasted image
For Each oIL In ww.InlineShapes
If oIL.Range.Start = iShapeStart Then Exit For
Next

'lock aspect ratio and scale to 40%
oIL.LockAspectRatio = msoTrue
oIL.ScaleHeight = 40

Exit Sub

errortrap:
'handle various errors
Select Case Err.Number
Case 13: MsgBox "Please open a Contact and try again"
Case 5941, 5855: MsgBox "Can't find picture in Notes"
Case Else: MsgBox ("An unknown error has occurred")
End Select
End Sub

Open in new window

1

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Jeffrey SmithOwnerAuthor Commented:
Thanks, Neil !  That's exactly what I was hoping to achieve and a sweet piece of code (far more complicated than the "fairly simple" Outlook 2010 Macro I envisioned at the start.  I appreciate your persistence in bringing this all the way home.

Cheers,

Jeff
0
Neil FlemingConsultant and developerCommented:
My pleasure.
1
Jeffrey SmithOwnerAuthor Commented:
Neil Fleming provided a very professional and timely solution, and worked through a couple of clarifying refinements to deliver exactly the results I was seeking.  Thanks again, Neil!
1
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.