Code For Excel And Outlook Blog

This blog has expired!

2008-06-13T21:15:00.002-04:00

Greetings,

Please visit my new blog located at

Code For Excel And Outlook

All of the existing blog posts from this blog are on the new site, so there is literally nothing here to read anymore. Please point your links to the blog listed above.

In a few weeks I will be redirecting all incoming links to the new blog, so you shouldn't see this blog any more after that.

Thx,
JP

Wordpress move almost complete

2008-06-10T23:17:00.001-04:00

Greetings,

The move to Wordpress is underway and almost complete, please bear with me as posts are moved and updated. It's pretty wonky right now. I should have this done in the next day or two.

Thx,
JP

Moving to Wordpress

2008-06-08T23:01:00.002-04:00

So I finally got enlightened and decided to move the blog to Wordpress. I'll be moving all of the posts over to the new blog located at

http://www.codeforexcelandoutlook.com/blog/

some time in the next few days. And I'll attempt to keep the Feedburner feed going as well. Right now of course the new blog is empty and completely uncustomized, because it's Sunday at 11pm, and I spent part of the 90 degree NYC afternoon on Sunrise Highway in Freeport with a flat tire (instead of at the beach), so it's time for bed.

So enjoy the old blog for now, soon it will be much cooler (no pun intended).

Bye for now,
JP

Highlight And Move Multiple Emails

2008-05-30T08:58:00.013-04:00

Okay so I said I would be writing some VBA code to export contacts and emails from Outlook to Excel, well, I lied, sort of. That code is still coming, but before I post it, here is a routine that lets you run VBA code on multiple messages at the same time. Most of my routines so far have been written to run on one email at a time:

Resend This Message
Save Incoming Attachments
Read those image files in Outlook

and so on.

This macro is perfect for manual execution of a routine on multiple emails. In the example below, I select a few emails from my Inbox and then move them to another folder. You could easily adapt this macro to forward all the selected messages, save attachments from all of them, etc.


Sub MoveToFolder()

Dim olMyFldr As Outlook.MAPIFolder
Dim MsgColl As Object
Dim Msg As Outlook.MailItem
Dim objNS As Outlook.NameSpace
Dim i As Long

' check if we have multiple items selected
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
    Case "Explorer"
        ' a collection of selected items
        Set MsgColl = ActiveExplorer.Selection
    Case "Inspector"
        ' only one item was selected
        Set Msg = ActiveInspector.CurrentItem
End Select
On Error GoTo 0

If (MsgColl Is Nothing) And (Msg Is Nothing) Then
    GoTo ExitProc
End If

Set objNS = Outlook.GetNamespace("MAPI")
Set olMyFldr = objNS.GetDefaultFolder(olFolderInbox).Folders("Completed")

' now we can act on the msg collection,
' or on the individual msg we selected

If Not MsgColl Is Nothing Then
' we selected multiple items
    For i = 1 To MsgColl.Count
        ' set an obj reference to each mail item so we can move it
        Set Msg = MsgColl.Item(i)
            With Msg
                .UnRead = False
                .Move olMyFldr
            End With
    Next i
ElseIf Not Msg Is Nothing Then
    With Msg
        .UnRead = False
        .Move olMyFldr
    End With
End If

ExitProc:
Set Msg = Nothing
Set MsgColl = Nothing
Set olMyFldr = Nothing
Set objNS = Nothing
End Sub

I highlighted in red the sections you would replace with your own code. The first
part (right after "Set Msg = MsgColl.Item(i)") is the one that loops through each
selected message and runs your code. So you can move, forward, copy, export, reply
with attachments, etc, each mail item you selected. The second one runs only if one
mail item is selected.

In both cases, the object variable "Msg" is a reference to the current mail item.
That's what you will be manipulating.

If you're saving attachments, for extra credit try adding the SelectFolder() Function
from the Save Incoming Attachments post.

Enjoy,
JP

Open Any Email Attachment From Outlook

2008-05-28T21:21:00.008-04:00

I was inspired to write some VBA code that lets you open any attachment in its native application by a recent newsgroup post from Sue Mosher. The truth is I was bored, and it was easy to code because I simply reused code I had just written for the Save Incoming Attachments post. Hopefully the value of a stock code library will now be apparent to you.

This code uses the Windows Script Host Object Model to let Windows choose what program to use to open an attachment. Actually, it uses whatever file associations that were created when the program was installed. For example, .doc files usually open in Microsoft Word (if you have it installed).

So instead of instantiating the object model for every possible attachment type (impossible), this method opens any attachment (as long as Windows knows what program to use). I haven't tested this with unknown attachments, so if anyone would like to try and let me know what happens (hopefully the file association dialog box appears), I'd be glad to hear it.


Sub OpenAttachmentInNativeApp()

' based on code posted by Sue Mosher
' http://tinyurl.com/684zg4
Dim myShell As Object
Dim MyItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Dim i As Long
Dim Att As String

On Error Resume Next
Select Case TypeName(Application.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
    GoTo ExitProc
End If

Set myAttachments = MyItem.Attachments

If myAttachments.Count > 0 Then
    For i = 1 To myAttachments.Count
        Att = myAttachments.Item(i).DisplayName
        
        ' delete just in case it exists from before
        On Error Resume Next
        Kill "C:\" & Att
        On Error GoTo 0
        
        myAttachments.Item(i).SaveAsFile "C:\" & Att
    Next i
End If

' Windows Script Host Object
Set myShell = CreateObject("WScript.Shell")
myShell.Run "C:\" & Att

ExitProc:
Set myAttachments = Nothing
Set MyItem = Nothing
Set myShell = Nothing

End Sub

And here's a link to the newsgroup thread:

Open an attachment in a new window using its native application

Enjoy,
JP

XML Parsing Function

2008-05-27T21:58:00.006-04:00

In keeping with my Website XML parsing post, here is a short function that returns the body text from a webpage as a string, on which you can use other functions like Instr, Left$, Mid$, etc, to extract necessary data.


Function URLText(sURL As String) As String

' check website.com using xml
' early bound
Dim xSite As XMLHTTP60

Set xSite = New XMLHTTP60
xSite.Open "GET", sURL, False
xSite.Send

Do Until xSite.readyState = 4
Loop

URLText = xSite.responseText

End Function

And it's as simple as that. You could even use it as a UDF. Here's a sample sub:


Sub CheckMySite()
Dim MyString As String
Dim i As Long

MyString = URLText("http://www.google.com")

If Instr(MyString, "Hello!") > 0 Then
    Cells(5,1).Value = Mid$(MyString, 1, 5)
End If

End Sub

This sub checks if the returned string contains the word "Hello" and if so, pulls the first five characters of the text and puts it in cell A5. It's just an arbitrary routine to show you what you can do with the XML response.

For my next trick, I will be showing you a routine that takes a snapshot of your Outlook inbox and writes it to a spreadsheet. I'm also planning on demonstrating some code that exports Contacts from Outlook to Excel.

Enjoy,
JP

Save Incoming Attachments, Choose Your Folder

2008-05-22T21:46:00.020-04:00

Here's a sub and a function for Outlook that let's you save attachments from a selected or open email. It's similar to the File>Save Attachments menu option, which lets you save all of the attachments from a particular email, or the FindControl Method, which can be used to find and execute "Save Attachments".

Now I realize that there is already a ton of code available that you can use to save attachments, but I found some code that uses the Shell application to let you pick the folder you want to use as the destination. So my purpose here is to demonstrate how to use this code in a simple routine.

It's a great technique and, since it is a separate function, it is very portable to other subs where you want to let the user pick a folder on their hard drive or network drive as the destination for files you want to save or use in a routine. It simply returns the full path as a string.

As you can see below, the String variable "SelectedFolder" is used to store the returned results from the SelectFolder() Function.

As usual, we set an object reference to a Mail Item, then loop through the attachments collection of that mail item and save each one. Notice that the bulk of the work is done inside the If statement (but outside the loop) to avoid costly object references that might be useless if the email doesn't have attachments (for example, if you run this code on the wrong email by mistake).


Sub GoThroughAttachments()
Dim MyItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Dim i As Long
Dim Att As String
Dim SelectedFolder As String

On Error Resume Next
Select Case TypeName(Application.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
    GoTo ExitProc
End If

If MyItem.Attachments.Count > 0 Then
    SelectedFolder = SelectFolder()

    If SelectedFolder <> "" Then     ' user didn't press Cancel

    Set myAttachments = MyItem.Attachments

    For i = 1 To myAttachments.Count
        Att = myAttachments.Item(i).DisplayName
        myAttachments.Item(i).SaveAsFile SelectedFolder & "\" & Att
    Next i
    End If
End If

ExitProc:
Set myAttachments = Nothing
Set MyItem = Nothing
End Sub


Private Function SelectFolder(Optional i_RootFolder As String) As String
' from http://vba-corner.livejournal.com/
Dim myShell As Object
Dim MyFolder As Object

  Set myShell = CreateObject("Shell.Application")
  If i_RootFolder = "" Then
    'no root folder given, use default (which is Desktop)
    Set MyFolder = myShell.BrowseForFolder(0, "Please select a folder:", 1)
  ElseIf Not (i_RootFolder Like "*[!0123456789]*") Then
    'number for special folder given
    Set MyFolder = myShell.BrowseForFolder(0, _
                   "Please select a folder:", 1, CInt(i_RootFolder))
  Else
    'path for root folder given
    Set MyFolder = myShell.BrowseForFolder(0, _
                   "Please select a folder:", 1, CStr(i_RootFolder))
  End If
  If Not MyFolder Is Nothing Then
    SelectFolder = MyFolder.self.Path
  End If
End Function

Notice that the SelectFolder() Function does not include the trailing slash at the end, so we need to add this when saving the file.

If you wanted to simply use the same folder every time (for example, C:\MyFiles\), just comment out this line:

SelectedFolder = SelectFolder()

Remove the inner If-End-If statement (If SelectedFolder <> "" Then) and change this line:

myAttachments.Item(i).SaveAsFile SelectedFolder & "\" & Att

to this:

myAttachments.Item(i).SaveAsFile "C:\MyFiles\" & Att

But why would you want to do a thing like that, when the Shell automation is so much cooler?

Click here to see how to add this code to a toolbar button in Outlook.

Enjoy,
JP

Read those image files in Outlook

2008-05-22T13:10:00.013-04:00

I recently discovered a new object library that seems pretty useful - the Microsoft Office Document Imaging Type Library. From the MSDN site:

The Microsoft® Office Document Imaging 2003 (MODI) object model makes it possible to develop custom applications for managing document images (such as scanned and faxed documents) and the recognizable text that they contain.

(end quote)

This object model is not available in Office 2002(XP).

Continuing with the Outlook theme from my latest blog posts, I can already see the potential for automating Outlook by handling incoming emails, opening image file attachments, then filing, saving or forwarding them depending on the image content, or using Excel to browse through a folder and doing the same thing. I wrote a short sub that can show you how to read an image file that is sent to you via Outlook attachment.

First you must set a reference to the Microsoft Office Document Imaging 11.0 Type Library. Here's mine on the left. And below is the code.


Sub ReadAttachment()

Dim MyItem As Outlook.MailItem
Dim MyAttach As Outlook.Attachments
Dim MyDoc As MODI.Document
Dim MyLayout As MODI.Layout
Dim Att As String
Dim strWords As String
Dim int As Long

    On Error Resume Next
    Select Case TypeName(Application.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
        GoTo ExitProc
    End If

This bit of code should be familiar, it is the stock code I always use to get a reference
to an item in a mail folder. Of course, the code assumes that you are acting on a mail item; to make sure, change "Dim MyItem As Outlook.MailItem" to
"Dim MyItem As Object" and then wrap the rest of the code below in a
"If MyItem.Class = olMail" statement. Or, just make sure you select or open a mail item before running this code.


Set MyAttach = MyItem.Attachments

If MyAttach.Count > 0 Then

    Att = "C:\" & MyAttach.Item(1).DisplayName
    MyAttach.Item(1).SaveAsFile Att
    
    Set MyDoc = New MODI.Document
    
    MyDoc.create (Att)

    MyDoc.images(0).OCR
    
    Set MyLayout = MyDoc.images(0).Layout
    
    For int = 0 To (MyLayout.NumWords - 1)
        strWords = strWords & " " & MyLayout.Words(int).Text
    Next int
    
    MsgBox strWords
    
Else
    GoTo ExitProc
End If


ExitProc:
Set MyItem = Nothing
Set MyAttach = Nothing
Set MyDoc = Nothing
Set MyLayout = Nothing

On Error Resume Next
    Kill Att
On Error GoTo 0

End Sub

The rest of the code simply saves the attachment to a file on the hard drive, creates a new image document, then builds a string consisting of the readable characters in the image file. That string could be parsed to see if it contains something you are looking for, for example


If Instr(strWords, "My String") > 0 Then
' your code here
End If

Enjoy,
JP

Outlook Automated File Request System

2008-05-12T20:12:00.010-04:00

Here is the finished code for the Outlook File Request System.

File Server Code

This is event code which acts as an automated file server, putting files into the specified folder, and sending files back to the requestor, all via email. Once the code is installed, another user requests a file from you by using the following syntax in the Subject line:

Subject: FILEGET drive:path\filename

Where 'drive' is is a valid drive letter, 'path' is the folder and 'filename' is the name of the file requested.

For example,

Subject: FILEGET E:\Files\MyFile.doc

To send a file to another user's folder, subject should be:

Subject: FILEPUT D:\

And there should be at least one attachment to the email. All attachments will be saved to the same folder.

Note that for security reasons, I limited access to the C: drive, however if you set up a folder called 'Shared' on your desktop (Windows 2000/XP), you can place files there that you want to share, and others can request files from there. Of course if this isn't a concern for you, you can simply remove those restrictions.

Due to object model restrictions, I decided to remove the feature that replies to the group (if applicable). For example, if you CC: five other people on your request, the code simply ignores the other recipients. Originally, I had it set up to reply to them all. However, accessing the Recipients collection of the mail item triggered the object model guard, which was contrary to the intent of the code which is to fully automate the request process. You'd have to sit there clicking 'OK' every time someone sent you a request!

All of this is done via Outlook automation. Due to the blogging software I use (which I'll probably change soon) I cannot post the full code here. I will be demonstrating some of the techniques used to produce this code; click the link above to get the entire thing in the proper format.

First, we initialize the event code using the following code which should be familiar to you by now, if you have browsed the Outlook page. This is stock code which should be part of your code library to be reused over and over.


Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()

Dim objNS As Outlook.NameSpace
  Set objNS = GetNamespace("MAPI")
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

All of this code should be placed in ThisOutlookSession module in your Outlook VBE. Just press Alt-F11, double-click on ThisOutlookSession and paste in the above code. Remember, after you install (or edit) the code in this module, you have to restart Outlook for any changes to take effect. Also, any existing code you have seems to stop working until you save and restart Outlook.

Here is the ItemAdd event code that is checking the Inbox for new mail items. We first set an object reference to the mail item that is passed as an argument. Then we determine the full path of the user's desktop folder, to figure out where the 'Shared' folder should sit. Keep in mind this will only work pre-Windows Vista. Then we check the subject line to see if it fits what we are looking for.


Private Sub Items_ItemAdd(ByVal item As Object)

If TypeName(item) = "MailItem" Then
    Dim ToDo As String
    Dim WhatAndWhere As String
    Dim Msg As Outlook.MailItem
    Dim MsgAttach As Outlook.Attachments
    Dim MsgReply As Outlook.MailItem
    Dim SlashSign As Long
    Dim sPath As String
    Dim sFile As String
    Dim fso As Object
    Dim UserN As String
    Dim DeskTopSharedFolder As String
    Dim strHelpText As String

' the mailitem is passed to the event code as an argument
Set Msg = item

' get current username so we can figure out the desktop folder name
UserN = Environ("username")
DeskTopSharedFolder = "C:\Documents And Settings\" & _
UserN & "\Desktop\Shared\"

On Error Resume Next
ToDo = Left$(Msg.Subject, 7)
WhatAndWhere = Right$(Msg.Subject, Len(Msg.Subject) - 8)
On Error GoTo 0

At this point we either have a FILEGET request or a FILEPUT request (or maybe neither). Then we cycle through every possible error condition (no attachments, malformed subject) and, if no errors occurred, call the sending sub which sends back the file requested (or saves the attachments to the specified folder).

In the interest of modular programming, there are actually four separate subs which each do something different:

1) The File Server Sub, acting as an intermediary sub which takes the validated user-input and passes it to the sending sub.

2) The Sending Sub, which takes four arguments (two optional) and is responsible for sending out all emails.

3) The Logging Sub, which (if you allow it) logs all file requests and sends to a CSV file, and

4) A String Checking Sub which checks if one string is found within another and returns a Boolean value (True or False).

Check out the full code here.

File Server Code

Enjoy,
JP

Free VB/C#/C++ Software

2008-05-10T11:37:00.006-04:00

In keeping with the theme from my last post, I started looking for tutorials or software for other programming languages that might make an eventual transition to VSTO easier. I found some useful software from Microsoft that is actually free.

Check out:
http://www.microsoft.com/express/download/

You can download "lite" versions of VB 2008, C# 2008, C++ 2008, SQL Server 2005, as well as something called Visual Web Developer 2008.

The one that looks most interesting to me is SQL Server, which I installed but have yet to try out. My plan is to use it to further understand the syntax and commands of SQL. I also installed VB Express, and sooner or later I'll get around to trying it.

One of the blurbs that actually made me laugh said "Control your home lights using Visual Basic Express". I just use the Off switch.

Unfortunately you need to install their Silverlight technology to properly view the page. Whatever happened to plain old HTML?

They also offer a DVD image you can download and burn. Seems convenient, but why anyone would want to do this, I don't know.

So check it out and let me know if you download or try any of them out.

Enjoy,
JP

VBA Rant #1

2008-05-07T23:17:00.006-04:00

I'm sure by now you are aware that Microsoft has been distancing itself from VBA.

As of July 1, 2007, they are no longer licensing VBA (to new clients). For example, if you wrote a program today and wanted to integrate VBA in it, you are out of luck.

And the new version of Office for Mac will not support VBA at all.

They seem to be pushing their other technologies like VSTO for automating Office programs.

I feel I have to weigh in on this subject because it seems like Microsoft used VBA to lock users into using their software, and is now abandoning them.

Now I realize VBA will still be around for many years. Hell, XLM macros are still working in Excel even after VBA was introduced 13 years ago to replace it. I still see newsgroup posts from people asking for help with macros in Excel 97 (11 years old!). But how long will Microsoft maintain backward compatibility with a language it is discouraging people from using?

I have browsed other languages like .NET, C++, and realize just how familiar VBA is. Maybe it's "Grumpy Old Man Syndrome" setting in early; I can already hear myself saying things like "Back in my day, you could write a macro in 5 minutes to list all the files in a folder!"

This is going to mean that, in general, code will start getting harder to find. VBA is the People's Code; simple to integrate and implement by almost anyone with a little experience. In contrast, you would almost have to be a professional developer to get code working in another language to interact with Office.

"Visual Studio Tools for Applications makes it easier to write reliable, robust, and secure customizations by providing managed extensibility for both COM and .NET applications." [From VSTO Site]

It reminds me of the Mission Statement Generator from Dilbert's website.

Will VBA eventually be deprecated? Will people still be coding in VBA 20 years from now? Or am I just completely off it and worrying about nothing? I will accept any suggestions for what programming language I should start learning.

--JP

Excel training class and Outlook file request system updates

2008-05-03T00:04:00.003-04:00

I've been mentioning the Excel training class for some time now, finally the curriculum is coming together and I finally got off my lazy butt and have almost completed the handouts and sample worksheets. I am hoping with fingers crossed to have this finally completed by the end of next week. Then I have to start taking public speaking classes to learn how to present this material in a way that won't put people to sleep. For practice, try explaining to someone an INDEX/MATCH array in a way that makes it sound fun!

In other news, the file request code I have been working on for Outlook is coming along quite nicely. It consists of three subs in a standard module, and the event code which would be placed in ThisOutlookSession. It's designed for business users (AKA "office drones like me") with network shares, who have better things to do than act as a human file server pushing files around all day. Let your lazy co-workers do it themselves! It would make you a hero while at the same time give you less work to do! Here are some of the features:

Request from, or submit files to, another user's computer or network share

C: drive is blocked, but you can create a folder on your desktop called "Shared" and place files in there that you want others to have access to (or place files in)

Friendly error messages in case of malformed requests (i.e. invalid path, no attachments).

Requestor can CC: others, and the code will send the requested file (along with confirmation email), to each of the recipients of the original message. However, ugly error messages are sent back to the original requestor only.

It also includes a built-in Help system, via the event code where users get an email back with instructions on how to request or send files to a folder. The instructions are also included at the bottom of every confirmation email.

All file sends and requests are logged to a .CSV file, the location and filename of which you can change as needed. The filename is passed as an argument to the function, so for example, you could update the code to write to different log files depending on whether someone was sending a file, or requesting a file. However the code as it stands will distinguish between the two when logging the request. Errors are also logged.

It's almost like a Kazaa or Limewire type setup where you have a shared folder and you trade files with other users, only in this case it's via email. And (hopefully, in your case) it's legal.

Enjoy,
JP

Internet Explorer Automation Object Library - Update for Excel 2007

2008-04-28T21:30:00.004-04:00

One of the most popular pages on this site shows code for automating Internet Explorer. However I have only tested the code in Excel XP/2003. The purpose of this post is to credit a gentleman named Durand Sinclair who, using Excel 2007, pointed out to me that the name of the IE object library in Excel 2007 is actually called "Microsoft Browser Helper" (click Tools>References in the VBE). Once you select the checkbox, exit the dialog box and re-enter it, the name changes to "Microsoft Internet Controls".

If anyone else would like to verify this behavior in Excel 2007 and let me know, I would be grateful to hear it.

Thanks Durand!

--JP

Contribute to this site!

2008-04-28T21:16:00.003-04:00

It's not what you think.

I'm asking for contributors to the VBA search engine!

If you know of a website with VBA samples, or think you have what it takes to identify good websites with code, I'd like to know about it.

Visit the VBA Search Engine Homepage and click "Volunteer to contribute". Send me a message (click here) and let me know you are going to do so.

You'll need a Google account to contribute to the search engine. An added bonus is you can add the search box to your Google homepage, so you can search whenever you want, and (if my eyes don't deceive me) you can also add the search engine code to your own blog or website!

Enjoy,
JP

Event Code for Forwarding Selected Text to Another Email Address

2008-04-27T10:03:00.006-04:00

Here is the event code I promised for forwarding emails to another email address. It does exactly the same thing as the previous code, but since it is event code, once you place it in a class module and restart Outlook, it runs automatically without any need for you to run macros by hand.

Start by pasting the following into the ThisOutlookSession module:



Private WithEvents Items As Outlook.Items


Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
  Set objNS = GetNamespace("MAPI")
  Set Items = objNS.GetDefaultFolder _
              (olFolderInbox).Items
End Sub

This code will set up the event handler. If you already have an Application_Startup event, simply copy and paste the inner code into it. Of course you'll want to check that you aren't duplicating any code; Option Explicit and a quick Debug>Compile will check for that.

The ItemAdd event will check any newly added items to the Inbox, and, if they meet the criteria we specify, a new mail item is created (via the Forward method) and sent to the email address of our choice. Then the original message is marked as read and neatly tucked away. Here is the complete code:


Private WithEvents Items As Outlook.Items


Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder _
            (olFolderInbox).Items
End Sub


Private Sub Items_ItemAdd(ByVal item As Object)

If item.Class = olMail Then
    If Left$(item.Subject, 16) = _
    "String to search" Then
        Dim Msg As Outlook.MailItem
        Dim NewForward As Outlook.MailItem
        Dim MyFolder As Outlook.MAPIFolder
        Dim olApp As Outlook.Application
        Dim olNS As Outlook.NameSpace

    Set Msg = item
    Set NewForward = Msg.Forward
    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set MyFolder = olNS.GetDefaultFolder _
    (olFolderInbox).Folders("Archive")

        With NewForward
            .Subject = _
            Right(Msg.Subject, Len(Msg.Subject) _
         - InStrRev(Msg.Subject, " "))
            .To = "myemail@mobiledevice.com"
            .HTMLBody = ""
            .Send
        End With

    With Msg
       .UnRead = False
       .FlagStatus = olNoFlag
       .Move MyFolder
    End With
    End If
End If

ExitProc:
Set NewForward = Nothing
Set Msg = Nothing
Set olApp = Nothing
Set olNS = Nothing
Set MyFolder = Nothing
End Sub

Paste this into the ThisOutlookSession module, save and restart Outlook to get the code to start working.

I chose some arbitrary criteria (the first 16 characters of the Subject Line), you would need to customize this for your needs.

Custom CSS tags for displaying well-formed VBA code

2008-04-26T22:07:00.013-04:00

So you might be wondering, what does VBA have to do with a web technology like CSS? If you are like me and you hand-code your website, you might find it difficult to display VBA code properly. Unfortunately, I can't seem to locate a copy of zHTML, and the other VBA-to-HTML converters I tried just don't seem to satisfy.

Since my website is formatted using CSS, I did a bit of digging and found I could create my own HTML tags. I was already using the PRE and TEXTAREA tags to format snippets of VBA code, but this technique allows you to create custom tags that make it simple to roll your own webpages. So I went ahead and wrote some CSS to format the four most commonly posted types of VBA code: Normal, Selection, Comment and Keyword Text. Here it is:

.vba
{ color: #000000;
background: #FFFFFF;
padding: 10px 10px 10px 10px;
font-size: 100%
}
.selected
{ color: #FFFFFF;
background: #330099;
}
.comment
{ color: #339933;
background: #FFFFFF;
}
.keyword
{ color: #330099;
background: #FFFFFF;
}

Paste the above code into the .css file that defines your site's layout. You can fiddle with the background color to make it suit your site better. Now you can wrap your VBA code in tags like this:


<pre class="vba">
<span class="keyword">Sub</span> fixformulas()
<span class="comment">'
' if you have some formulas with a ' or some other
' character in the beginning
'</span>
<span class="keyword">Dim</span> cell
<span class="keyword">As</span> Excel.Range
<span class="keyword">For Each</span> cell 
<span class="keyword">In </span> Selection
    cell = "=" & Right(cell, Len(cell) - 1)
<span class="keyword">Next</span> cell
<span class="keyword">End Sub</span>
</pre>

And it will display like this:


Sub fixformulas()
'
' if you have some formulas with a ' or some other 
' character in the beginning
'
Dim cell As  Excel.Range
For Each cell In Selection
    cell = "=" & Right(cell, Len(cell) - 1)
Next cell
End Sub

The PRE tag wraps the area in the "vba" tag, which is the default black-on-white
text used to display most VBA code (if you haven't fiddled with the default settings in the VBE). So any code that isn't wrapped in a span tag will automatically take on the default color, which is the intuitive way the VBE does it.

Instead of using the deprecated FONT tags or trying to guess the hex values for colors every time you want to use them, you can use friendly words like "keyword" or "comment" in your SPAN tags and the code will be colored accordingly. The PRE tag will also make sure the code is indented properly!

Eventually I'll convert all the existing code to this format, and all future code posted on the blog and the website will be displayed using these custom made CSS class tags.

(ps- the Outlook event code I promised last week is coming up in the next day or two. I was away this week so I have a lot of catching up to do.)

Enjoy,
JP

Forwarding Selected Text to Another Email Address

2008-04-16T22:22:00.016-04:00

Greetings,

I would like to share some code I wrote last month for a user who visited my website and asked for a macro that would look for specific text in the subject of an email and forward it to another email address (in this case, an email for a mobile device). I created two versions: a Sub procedure that could be run on demand, and Event code that would automatically (in the "hands off" spirit) forward a specially crafted email.

In this post I will show the macro you would assign to a toolbar button. If you want to add this (or any other) macro to your Outlook toolbar, check out "How to assign a macro to a toolbar button" on this page. In the next post I will follow up with the Event code.

The toolbar code should be placed in a standard module in your Outlook VB Project.

First we check what type of window we are looking at by checking the ActiveWindow Property of the Application object; if it is an Explorer, that means we don't have any emails open, so we set an object reference to the first selected item. If it is an Inspector, we have an email or other item open for viewing, so we set an object reference to it. Of course, if there is no selected item, or no open item, the code fails with an error because we can't run it.


Sub FwdMailText()
Dim objItem As Object
Dim Msg As Outlook.MailItem
Dim NewForward As Outlook.MailItem
Dim MyFolder As Outlook.MAPIFolder
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace

On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
  Case "Explorer"
  Set objItem = _
     Application.ActiveExplorer.Selection.item(1)
     Case "Inspector"
  Set objItem = _
  Application.ActiveInspector.CurrentItem
End Select
On Error GoTo 0

If objItem Is Nothing Then
  MsgBox "Nothing selected!", _
     vbExclamation
  Goto ExitProc
End If

If we made it this far, we check if our object reference is to a MailItem
by checking the Class Property for the olMail constant. If it is indeed a MailItem, we set a friendly object reference "Msg" to it. I like to use string variables that easily identify what the variable represents; similar to Hungarian notation. That way I can spend more time worrying about what the code should do and less time guessing what each variable does every time I look at it. Fortunately, "Msg" is one of those non-reserved keywords that make it obvious.


If objItem.Class = olMail Then
Set Msg = objItem
Else
 MsgBox "No message selected!", _
    vbExclamation
  GoTo ExitProc
End If

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set MyFolder = olNS.GetDefaultFolder(olFolderInbox)._
Folders("Archive")

At this point we execute the Forward Method of the MailItem object,
which creates a new email message based on the original, and returns an object reference to the about-to-be-forwarded MailItem. We set up the Subject: and To: fields, and use the Subject: from the original MailItem to create the Body of the forwarded item.

After sending the message, we move the original email to the folder called "Archive" which is one level below the default Inbox (see object reference for "MyFolder").


Set NewForward = Msg.Forward
With NewForward
  .Subject = "Information You Requested"
  .To = "myemail@mobiledevice.com"
  .Body = Right(Msg.Subject, _
      Len(Msg.Subject) - InStrRev(Msg.Subject, " "))
  .Send
End With

With Msg
  .UnRead = False
  .FlagStatus = olNoFlag
  .Move MyFolder
End With

ExitProc:
Set NewForward = Nothing
Set Msg = Nothing
Set objItem = Nothing
End Sub

Here is the code in its entirety:


Sub FwdMailText()
Dim objItem As Object
Dim Msg As Outlook.MailItem
Dim NewForward As Outlook.MailItem
Dim MyFolder As Outlook.MAPIFolder
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace

On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
  Case "Explorer"
  Set objItem = _
  Application.ActiveExplorer.Selection.item(1)
  Case "Inspector"
  Set objItem = _
  Application.ActiveInspector.CurrentItem
End Select
On Error GoTo 0

If objItem Is Nothing Then
  MsgBox "Nothing selected!", _
     vbExclamation
  Goto ExitProc
End If

If objItem.Class = olMail Then
  Set Msg = objItem
Else
  MsgBox "No message selected!", _
  vbExclamation
  GoTo ExitProc
End If

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set MyFolder = olNS.GetDefaultFolder(olFolderInbox)._
Folders("Archive")
Set NewForward = Msg.Forward


With NewForward
    .Subject = "Information You Requested"
    .To = "myemail@mobiledevice.com"
    .Body = Right(Msg.Subject, _
Len(Msg.Subject) - InStrRev(Msg.Subject, " "))
    .Send
End With

With Msg
    .UnRead = False
    .FlagStatus = olNoFlag
    .Move MyFolder
End With

ExitProc:
Set NewForward = Nothing
Set Msg = Nothing
Set objItem = Nothing
End Sub

For the Body property, I chose to include the text from the subject line (everything starting from the left all the way up to the first space) of the original item, but you can include anything you want. If you wanted to include the original message body in the forward, try this:

.Body = Msg.Body

If you are curious about the properties and methods of the MailItem object, you can enter a new line right below "With NewForward" and type a period "." You should get a dropdown list of everything you can do with a MailItem, courtesy of Intellisense. Once you select one, you can press F1 for assistance and sample code. This is a great way to learn about the properties of an object; just declare an object of a specific type, then start typing "objectname." and you get that list. Just be sure you go to the Options in the VB Editor in Outlook (press Alt-F11, then go to Tools>Options) and on the Editor tab, check all the boxes in the "Code Settings" frame.

Enjoy,

Hands Off That Email Attachment!

2008-04-14T13:49:00.008-04:00

About halfway down the Outlook page, there is some VBA code for opening an Excel workbook attached to an email, running a macro on it, then cleaning up and moving the email to another folder.

Here is some more sample code to make your macro even more intelligent. This code opens the attachment, then scans through the spreadsheet looking for an error condition. If the error condition is met, an email is generated to another mailbox, as an alert, and the email is left in the Inbox to be looked at by a human. If the error condition isn't met, there's no reason to look at the email, so it gets marked as read and moved to an archive folder.

If you are like me, then your time is valuable. You don't want to spend time looking at emails that you don't need to work on. This code lets me focus on high-value activities while using Outlook's built-in capabilities to ignore the spreadsheets that don't need personal attention.

First you want to open ThisOutlookSession and paste this event code:

Private WithEvents QueueInbox As Outlook.Items
Dim bWasPosted As Boolean

Really you can use anything in place of "QueueInbox", but I use something that will relate to the task so I can easily identify what the code is doing. The boolean variable is put in the global section because we are using it in one procedure (the mail sending sub) and checking the value in another sub.

Now you need to tell Outlook to monitor your chosen Inbox for new items. This code placed in the Application_Startup event will do that.

Set QueueInbox = objNS.Folders("Mailbox - My Mailbox Name").Folders("Inbox").Items

Replace "My Mailbox Name" with the name of the mailbox you want to check. For example, if I were running this on my own Inbox, the code would be

Set QueueInbox = objNS.Folders("Mailbox - Jimmy Pena").Folders("Inbox").Items

If you don't have an Application_Startup event, just put "Private Sub Application_Startup()" right above the Set statement, and "End Sub" right below it.

Now on to the real work. When a new item is added to the Inbox we selected, it saves and opens the attachment, checks to make sure everything is OK, and if so, moves the email to an archive folder. Don't forget to set a reference to the Excel object library (see binding page for assistance).

Of course I make some assumptions here, which you might want to change. For example, the emails we are checking have a known sender and subject, which was pre-arranged. Also, they always have one .xls attachment. If you can agree on a system like this, you'll be able to use Outlook code to automate some pretty boring processes.

Private Sub QueueInbox_ItemAdd(ByVal Item As Object)

Dim objNS As Outlook.NameSpace
Dim ArchiveFolder As Outlook.MAPIFolder
Dim Msg As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Const attPath As String = "C:\"
Dim colACount As Long
Dim colGCount As Long
Dim cell As Excel.Range
Dim MyBook As Excel.Workbook
Dim MySheet As Excel.Worksheet
Dim colARange As Excel.Range
Dim colGRange As Excel.Range
Dim bBadCount As Boolean

bWasPosted = False
bBadCount = False

Set objNS = GetNamespace("MAPI")
' the archive folder we are moving emails to
Set ArchiveFolder = objNS.Folders("Mailbox - My Mailbox Name")._
Folders("Inbox").Folders("Archive")

' check to make sure we are looking at a mailitem
If TypeOf Item Is Outlook.MailItem Then
If (Item.SenderName = "MySender@somewhere.com") And _
(Item.Subject = "Attachment You Requested") Then
' obj ref to msg
Set Msg = Item
' get attachment
Set myAttachments = Msg.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att

' open workbook and check for errors
Set XLApp = New Excel.Application
Set MyBook = XLApp.Workbooks.Open(attPath & Att)
Set MySheet = MyBook.Sheets(1)

' check count of columns A & G to make sure they match
' at this point you could do anything you want to the workbook, as if you
' were in the Excel VBE
Set colARange = MySheet.Range("A2:A5000")
Set colGRange = MySheet.Range("G2:G5000")

colACount = colARange.SpecialCells(xlCellTypeConstants).Count
colGCount = colGRange.SpecialCells(xlCellTypeConstants).Count

If colACount <> colGCount Then
' we found an error!
MyBook.Close False
' call other macro and pass email to it as an argument,
' so we can use some properties of the current mailitem
Call PostMsg(Msg)
bBadCount = True
End If

' bBadCount is a boolean variable checking if the match count
' caused an error, we skip further checks if that is the case
' because we only need one error

If bBadCount = False Then
' the count matched, but maybe we have invalid values
For Each cell In colGRange.SpecialCells(xlCellTypeConstants, 2)
If (cell.Value = "#N/A") Then
MyBook.Close False
Call PostMsg(Msg)
End If
Next cell
End If

' at this point, if PostMsg was called,
' bWasPosted would be True

If bWasPosted = False Then
' we didn't post a msg to MyInbox, so there must be
' nothing wrong with the attachment, so we can move it
With Msg
.UnRead = False
.Move ArchiveFolder
End With
End If
End If
End If

ExitProc:
On Error Resume Next
XLApp.DisplayAlerts = False
XLApp.Workbooks.Close
XLApp.DisplayAlerts = True
Kill attPath & Att
XLApp.Quit
On Error GoTo 0
Set ArchiveFolder = Nothing
Set objNS = Nothing

End Sub

Sub PostMsg(Msg As Outlook.MailItem)
'
' sub that actually puts the email in the inbox
'
Dim NotifyMsg As Outlook.MailItem
Dim MyFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace
Dim strMsg As String

Set objNS = GetNamespace("MAPI")
Set MyFolder = objNS.Folders("Mailbox - Jimmy Pena").Folders("Inbox")

Set NotifyMsg = MyFolder.Items.Add(olMailItem)

With NotifyMsg
.Subject = "Invalid Attachment Received"
.Importance = olImportanceHigh
.To = "jpena@myemail.com"
strMsg = "The following message was received by Queue Inbox on " & Msg.ReceivedTime & ":"
strMsg = strMsg & vbCr & vbCr & Msg.Body
strMsg = strMsg & vbCr & vbCr & "This is an automatically generated message."
.Body = strMsg
.UnRead = True
End With

bWasPosted = True

NotifyMsg.Send

End Sub

After implementing this code, you'll see that it checks incoming mail items for the ones with the appropriate sender and subject, browses through the attachment for errors, and sends an email to your Inbox of choice if an error is found. If no error is found, it quietly marks the email as read and moves it to another folder.

Now, hands off!

Enjoy,
JP

Updated blog and new pages

2008-04-08T16:24:00.005-04:00

As you may have noticed, I decided to update the blog, because it was getting hard to navigate. The color scheme was just bringing me down, so I spent about 4-5 hours changing it. That might seem like a lot of time, but I'm a perfectionist so once I start working I don't stop until it's perfect. I guess it's just the programmer in me.

Speaking of which, I added two new pages to the site: one with a great circle distance UDF and another with some samples for using the varType() function.

I am also working on a set of Outlook macros/event code to use as a file put/request system. Once added to your Outlook, other people would send you emails with a specially formatted subject; your system would respond by sending the requested file as an attachment, or putting the received attachments into the folder specified by the sender.

Enjoy,
JP

UDF to return page headers/footers text

2008-04-07T12:07:00.004-04:00

Here's a series of short UDFs that will return the page headers and footers for the active worksheet.

Function GetLeftHeader()
GetLeftHeader = ActiveSheet.PageSetup.LeftHeader
End Function

Function GetCenterHeader()
GetCenterHeader = ActiveSheet.PageSetup.CenterHeader
End Function

Function GetRightHeader()
GetRightHeader = ActiveSheet.PageSetup.RightHeader
End Function

Function GetLeftFooter()
GetLeftFooter = ActiveSheet.PageSetup.LeftFooter
End Function

Function GetCenterFooter()
GetCenterFooter = ActiveSheet.PageSetup.CenterFooter
End Function

Function GetRightFooter()
GetRightFooter = ActiveSheet.PageSetup.RightFooter
End Function

To use: Just put the function name in the cell, prefixed by an equal sign. For example, to get the left header text in cell A1:

=GetLeftHeader()

If you use any of these functions in a workbook other than the one where the code resides (ex: your PERSONAL.XLS workbook), you may have to prefix the code like this:

=PERSONAL.XLS!GetLeftHeader()

You can also use them in VBA code to get the associated property and take appropriate action, for example:

Sub TestMe()
Dim strMyHeader As String

strMyHeader = GetLeftHeader

If strMyHeader <> "My Company Name" Then
ActiveSheet.PageSetup.LeftHeader = "Company Name"
Else
MsgBox strMyHeader & " is your company's name."
End If

End Sub

HTH,

JP

Rows to Repeat at Top

2008-04-07T11:51:00.003-04:00

If you want to programmatically set the "Rows to Repeat At Top" option on the Sheet tab in Excel's Page Setup dialog box, here are two ways to do it.

If you already know what range you want, you could use this code:

ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"

This would set row 1 (which would ideally be a list of column headers) to print at the top of every page.

To set this option based on a user selection:

ActiveSheet.PageSetup.PrintTitleRows = Selection.Areas(1).Address

This code assumes that you have selected at least one entire row, i.e. select rows 1 through 4 then use the code above to set "Rows to repeat at top" to $1:$4.

HTH,
JP

Excel User Conference

2008-04-04T14:49:00.001-04:00

I was browsing Jon Peltier's blog and found a link to the Excel User Conference. It being held in Atlantic City which is only a couple hours' drive from my house, so I will be attending. And as soon as I save the money to pay the attendance fees, I'll be able to say that with 100% confidence.

If you are in the area and are reading this blog, you should try to attend. Check out the link to the conference to see the topics and presenters.

Enjoy,
JP

Training class update

2008-04-03T16:30:00.003-04:00

The Advanced Excel class tutorial is almost finished. I still have to write the section on 'Macros'. I'm considering just cutting and pasting from the web, because I'm not sure I have the strength to write something from the ground up. Or it might just be a brief introduction with some simple examples -- you can't teach macro writing in a 3 hour class. I've been writing them semi-regularly for the last three years and only in the last three months have I been doing it on an almost daily basis.

Speaking of which, some of the code I wrote way back then is atrocious, but it got the job done. Even to this day it is still being used in my organization and saves countless man-hours of tedious manual work.

Like I said a few months ago, I will post the sample workbooks and the written tutorial once it's done. I'm not a technical writer, but I like the way it seems to be coming together. I had to figure out how to sync up the workbooks with the written text to make it all flow together like course material should. Not easy! But I think I managed to pull it off, and it's definitely reusable if anyone wants to re-use it.

Keep thinking,
JP

Quickly Clear Conditional Formatting

2008-04-01T22:29:00.005-04:00

Here is a simple sub that deletes conditional formatting from a selection. The code does some prelim checking to see that it is actually acting on a range, and it mimics Excel's usual behavior (like a good VBA procedure should, if I may say so) by acting on the entire worksheet if you only select a single cell. However I recommend just selecting the range before you run the code.

Sub Clear_Cond_Formatting()
Dim rng As Excel.Range

If TypeName(Selection) <> "Range" Then Exit Sub
If TypeName(Selection.Parent) = "Chart" Then Exit Sub
If TypeName(Selection.Parent.Parent) = "Chart" Then Exit Sub

Select Case Selection.Cells.count
Case 1
Set rng = Cells
Case Else
Set rng = Selection
End Select

On Error Resume Next
rng.FormatConditions.Delete
On Error GoTo 0
End Sub

Enjoy,
JP