Thursday, November 27, 2014

Resize all image in MS Outlook via Macro

Its a Pain to keep doing image resize manually, and i found this:-
http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_27768384.html

So here is ME shamelessly copying the solution here:-
1.  Start Outlook
2.  Press ALT+F11 to open the Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects
4.  If not already expanded, expand Modules
5.  Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
6.  Copy the code from the code snippet box and paste it into the right-hand pane of Outlook's VB Editor window
7.  Click the diskette icon on the toolbar to save the changes
8.  Close the VB Editor

Here's how to add a button to the QAT for running the macro with a single click.
Outlook 2010.  http://www.howto-outlook.com/howto/macrobutton.htm#qat

Sub ResizeAllPicsTo75Pct()
    Const wdInlineShapePicture = 3
    Dim olkMsg As Outlook.MailItem, wrdDoc As Object, wrdShp As Object
    Set olkMsg = Application.ActiveInspector.CurrentItem
    Set wrdDoc = olkMsg.GetInspector.WordEditor
    For Each wrdShp In wrdDoc.InlineShapes
        If wrdShp.Type = wdInlineShapePicture Then
            wrdShp.ScaleHeight = 75
            wrdShp.ScaleWidth = 75
        End If
    Next
    Set olkMsg = Nothing
    Set wrdDoc = Nothing
    Set wrdShp = Nothing
End Sub
                       

No comments: