Outlook: VBA Script to display all unread messages

I wanted a button on Outlook that would let me catch up with all my emails by opening each unread email one by one. There is a button on the reader pane for this, but I specifically wanted to be able to do this quickly from the main window. Also I was casting about for something geeky to do and this caught my eye.

Here is the code to make it happen:

Sub find_unread()
    On Error GoTo eh:
    ' I want to be able to catch up by reading all my unread messages
    Dim ns As Outlook.NameSpace
    Dim folder As MAPIFolder
    Dim item As Object
    Dim msg As MailItem
    
    ' Open the inbox folder
    Set ns = Session.Application.GetNamespace("MAPI")
    Set folder = ns.GetDefaultFolder(olFolderInbox)

    ' Loop through items in the inbox folder
    For Each item In folder.Items
        DoEvents
        If (item.Class = olMail) And (item.UnRead) Then
            ' This message has not been read.  Display it modally
            Set msg = item
            msg.Display True
            ' uncomment the next line to have it only find one unread 
            ' message at a time
            'Exit For
        End If
    Next
    
    ' If you uncommented the line to read individual messages,
    ' comment the next line so you don't get a message box
    ' every single message!

    MsgBox "All messages in Inbox are read", vbInformation, "All Read"
    Exit Sub
eh:
    MsgBox Err.Description, vbCritical, Err.Number
End Sub

To make this work,

1. hit alt-F11 to show the macro window,
2. double-click ThisOutlookSession
3. and paste this code into the resulting window.
4. Save it, then back in the Outlook primary window, right-click the button bar and choose Customize....
5. On the "Commands" tab, scroll down to "Macros" in the Categories window and click "Macros"
6. Select your macro in the "Commands" window and drag it over to the button bar.

You can clean up the button if you like.

To use the command, press the button and each unread message will open, one at a time. When you close a message, the next message will open.

Visio Org Charts: Change Border Color Based on a Custom Property

I recently was asked to modify an existing Visio Org Chart based on a custom property. Every person in the org chart had a custom property for a BlackBerry number. Based on whether the person had a blackberry number or not, my client wanted the border to be set to a thick red line.

I came up with the following code to do just that:

Sub set_blackberry_border_red()
  Dim vsoPage As Visio.Page
  Dim VsoShp As Visio.Shape
  Dim i As Integer

  For Each vsoPage In ActiveDocument.Pages
    ' Loop through each page
    For Each VsoShp In vsoPage.Shapes
      ' Loop through every shape on the page
      If Not VsoShp.OneD Then
        ' Shape is not a line
        nrows = VsoShp.RowCount(Visio.visSectionProp)
        ' Set shape to normal border
        black_border VsoShp
        For i = 0 To nrows - 1
          ' Look at all properties
          If VsoShp.CellsSRC(Visio.visSectionProp, i, visCustPropsLabel).ResultStr(Visio.visNone) = "Blackberry" Then
            ' If property is blackberry phone number...
            If VsoShp.CellsSRC(Visio.visSectionProp, i, visCustPropsValue).ResultStr(Visio.visNone) <> "" Then
              ' ... set its border color to red
              red_border VsoShp
            End If
          End If
        Next i
      End If
    Next VsoShp
  Next vsoPage
  MsgBox "Finished.", vbInformation
End Sub

Sub red_border(shp As Visio.Shape)
  ' Set border size thicker
  shp.CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = "1.2 pt"
  ' Set Border color to red
  shp.CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = "2"
End Sub

Sub black_border(shp As Visio.Shape)
  ' Set border size to thin
  shp.CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = "0.24 pt"
  ' Set border color to black
  shp.CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = "0"
End Sub

VBScript: How to ensure the script is running from the command-line

There is a pretty awful feeling when you're debugging a VBScript that produces hundreds of lines of output, and you absent-mindedly double-click the VBS icon and it starts producing message box after message box. When you do this, you are pretty well stuck. You either go to task manager and kill the wscript.exe instance (and pray it doesn't mess anything up) or click "OK" a few hundred times.

If you put this little piece of code at the beginning of your VBScript, you can avoid this:

'check that we're running from cscript
if lcase(right(Wscript.FullName, 11)) <> "cscript.exe" then
   wscript.echo "Please run this using cscript"
   wscript.quit 0
end if
' Okay, proceed with the regular program
for n = 1 to 1000
   wscript.echo n
next

VB: Convert any Access table to CSV without truncating numbers

We produce a lot of CSV files in my current job. A lot of the time they come out of Access databases. But when you export CSV from Access, it does funny things you don't want, like truncating numbers or representing them in exponential representation. I wrote this VBScript to solve that problem. It takes the name of an Access database, the name of a table, and an output file as its input and creates a CSV file of the contents of one whole table. The script could be tweaked to work with other file types by giving the correct connection string:

Note: A lot of folks have written who were familiar with Access but who could not make the VBScript run. Here is one way to make this script run:

1. Open Notepad
2. Paste this code into the notepad. Be sure that you are careful to fix lines that may have split onto two lines.
3. Save the text file in notepad to "DB_to_CSV.vbs" in "My Documents"
4. Open "My Documents" and double click the DB_to_CSV.vbs file.

This should open the script and prompt you for the database and the table you want to export.

Incidentally, VBScript is one of the most powerful features of Microsoft Windows. They hid an entire programming language right in the operating system. Granted, it is not Java or C++, but you can do a lot of very cool stuff with VBScript. You can even easily do a lot of things that would be very difficult to code in a more advanced programming language (this script is an example).

option explicit

const ForWriting = 2

'Prompt for these variables
dim file_name
file_name = "C:\data\test_data.mdb"
dim table_name
table_name = "sales"

' Prompt the user for a database name
file_name = inputbox("Access filename?", "Access to CSV", file_name)
if (file_name = "") then
    ' The user hit "Cancel"
    wscript.quit
end if

' Prompt the user for a table name
table_name = inputbox("Table name?", "Access to CSV", table_name)
if (table_name = "") then
    ' The user hit "Cancel"
    wscript.quit
end if

' Prompt the user for a table name, default to the Access database name
' with .CSV concatanated to the end.
dim output_file
output_file = file_name & ".csv"
output_file = inputbox("Output CSV file name?", "Access to CSV", output_file)
if (output_file = "") then
    ' The user hit "Cancel"
    wscript.quit
end if

doit file_name, table_name, output_file

Sub doit(file_name, table_name, output_file)
    Dim sql
    Dim cn
    Dim rs
    Dim oxl
    dim t
    t = timer

    file_name = trim(file_name)
    table_name = trim(table_name)

    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    
    ' Here we set connection properties, open a connection, and create a recordset with the SQL
    ' Note that setting the properties takes the place of creating a connection string.
    With cn
        ' This can work with other databases.  Look at http://connectionstrings.com/
        ' You could extend this to accept other database types.

        if (right(file_name, 6) = ".accdb") then
            ' For Access 2007, use this:
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & file_name & ";Persist Security Info=False;"
        elseif (right(file_name, 4) = ".mdb") then
            ' This is for Access 2003 files
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & file_name & ";User Id=admin;Password=;"
        else
            wscript.echo "I don't recognize this file type: " & file_name
            wscript.quit
        end if
        .Open
    End With


    ' Here we specify the SQL we want to select data from
    sql = "SELECT * FROM [" & table_name & "]"
    rs.Open sql, cn

    ' Prepare the output CSV file
    output_file = trim(output_file)
    dim fso, file
    Set fso = CreateObject("Scripting.FileSystemObject")
    set file = fso.opentextfile(output_file, ForWriting, TRUE)

    wscript.echo "I'll output the CSV file to " & output_file

    ' Let's output the header row
    dim col
    dim line_to_write
    line_to_write = ""
    for col = 0 to rs.fields.count - 1
     line_to_write = line_to_write & ", " & rs(col).name
    next

    ' knock off the leading comma
    line_to_write = mid(line_to_write, 3)
    file.write line_to_write & vbcrlf

    ' Write out lines of data
    dim number_rows 
    number_rows = 0

    Do While Not rs.EOF
        line_to_write = ""
        For col = 0 To rs.Fields.Count - 1
     line_to_write = line_to_write & ", """ & rs(col).value & """"
        Next
        ' knock off the leading comma
        line_to_write = mid(line_to_write, 3)
        file.write line_to_write & vbcrlf
        number_rows = number_rows + 1
        rs.movenext
    Loop
    rs.Close

    wscript.echo "I'm done.  I wrote " & number_rows & " rows to " & output_file & " in " & cstr(timer - t) & " seconds"

    ' Close all of the ADODB objects
    If rs.State = 1 Then
        rs.Close
    End If
    If cn.State = 1 Then
        cn.Close
    End If
    Exit Sub
End Sub

One nice thing about this code is that it does not require you to know the names of the columns in the table you are exporting to CSV.

VBScript: how to run a program from vbscript

I always need this one: how do you run a program from within VBScript? For example, you may need to launch notepad or wget from a VBScript. Here is the code to launch notepad:

sub shell(cmd)
    ' Run a command as if you were running from the command line
    dim objShell
    Set objShell = WScript.CreateObject( "WScript.Shell" )
    objShell.Run(cmd)
    Set objShell = Nothing
end sub

shell "notepad"

Put that in a text file called "run_notepad.vbs", doubleclick it, and notepad will run. This may not seem too useful, but imagine that you use VBScript to run a series of WGETs, for example, based on input from SQL Server.

---

UPDATE

I have had a lot of requests for enhancements to this program. The following is the cadillac version. It calls an EXE and asks the user for parameters to pass to the EXE.

 
sub shell(cmd)    
    ' Run a command as if you were running from the command line
    dim objShell
    Set objShell = WScript.CreateObject( "WScript.Shell" )
    objShell.Run(cmd)
    Set objShell = Nothing
end sub

dim file_name
' Ask the user for a parameter
file_name = inputbox("What file to see?", "File name?", "c:\boot.ini")
if file_name <> "" then
    ' The user gave the parameter.  Open the program
    ' with the value the user gave.
    shell "C:\WINNT\system32\notepad.exe " & file_name
else
    msgbox "User cancelled.", 16, "User cancelled"
end if