A Macro to List All Programs in the Windows Start Menu

Most of the things I write for TechTrax have something to do with system administration and making that job a little more tolerable through the use of the Windows Script Host. One of the more natural, yet uninformed, comments I hear, though, has to do with people thinking I'm taking them back to the bad old days of DOS to get anything done.

What they don't yet understand, of course, is that those GUI apps they're using, like Word and Excel, don't have any business on servers and just don't work well if there isn't a user to click on this or that and get a job done. But there are things I run across occasionally to bridge the gap between server ops via script and regular user applications.

Recently, one of the mailing lists to which I subscribe delivered a question about how to get a printed list of all the Programs available from Start/Programs. After being declared Off-Topic (it was a Microsoft Office list), the resulting thread made me rethink the question and realized that an Office app—Microsoft Word, specifically, was a natural choice for the task. I risked the moderator's ire by treating the request with a serious attempt to provide the solution in the form of a Word macro. And, to keep things simple, the solution would be based on the use of the FileSystemObject to get the results.

In fact, the result is a not so subtle reach directly into my normal haunts—the dark confines of the Windows Script Host. In effect, Word would be used to contain the Windows Script Host and the FileSystemObject. Sounds complicated, right?

Not really and it's not so messy as you might think!

You've two choices for getting a look at this example; either open a new Template project, open the VB Editor, insert a code module and paste the code from this article into it—OR—download the unsigned, Word Template that accompanies this article. Bear in mind that there is no provision within the code to differentiate between Windows 9x and Windows NT variants. This example is designed to work properly with Windows NT/2000/XP. If you try it in 9X, it will be potluck and a fun experiment for you to convert for use in those environments. (Hint: It's not that difficult to do yet it's not a trivial thing to do. I encourage you to try.)

To run the macro, create a new Document based on the ListAllPrograms template, click Tools then Macros and choose PrintAllPrograms from the list. Click Run and watch the entire Programs tree become an organized, printable list in Word!

For those who are learning VB(A)(Script), it's getting harder to tell the difference between those languages, you may also step through the code in the VB Editor by pressing the F8 key to execute each instruction.

Use this link to Download ListAllPrograms.dot (zipped 9k file) or visit the TechTrax Library for this and other useful downloads.

Have fun!

Public objFSO
Public arrDirs

Sub PrintAllPrograms()

Set objFSO = CreateObject("Scripting.FileSystemObject")

GetSpecialFolders

ActiveDocument.Sections(1).PageSetup.Orientation = _
    wdOrientLandscape

With Selection
    .Font.Underline = wdUnderlineSingle
    .Font.Size = 10
    .Font.Bold = True
    .TypeText Text:="Programs for Current User: " & _
    arrDirs(0) & vbCrLf
    .Font.Bold = False
    .Font.Size = 8
    .Font.Underline = wdUnderlineNone
End With

EnumFolders (arrDirs(0)), 0
Selection.TypeText Text:=Chr(124) & vbCrlLf
EnumFiles (arrDirs(0)), 0

Selection.InlineShapes.AddHorizontalLineStandard

With Selection
    .TypeText Text:=vbCrLf
    .Font.Underline = wdUnderlineSingle
    .Font.Bold = True
    .Font.Size = 10
    .TypeText Text:="Programs for All Users: " & _
    arrDirs(1) & vbCrLf
    .Font.Bold = False
    .Font.Size = 8
    .Font.Underline = wdUnderlineNone
End With

EnumFolders (arrDirs(1)), 0
Selection.TypeText Text:=Chr(124) & vbCrlLf
EnumFiles (arrDirs(1)), 0

End Sub

Private Sub GetSpecialFolders()

Dim wshShell

ReDim arrDirs(1)

Set wshShell = CreateObject("WScript.Shell")
  
arrDirs(0) = wshShell.SpecialFolders("AllUsersPrograms")
arrDirs(1) = wshShell.SpecialFolders("Programs")

Set wshShell = Nothing

End Sub

Private Sub EnumFolders(strFolderPath, intDepth As Integer)

Dim Folders, SubFolders, i

If intDepth <> 0 Then
    For i = 0 To intDepth
        strTab = strTab & vbTab
    Next i
Else
    strTab = ""
End If

Set Folders = objFSO.GetFolder(strFolderPath)
Set SubFolders = Folders.SubFolders

For Each Folder In SubFolders
    With Selection
        .Font.Underline = wdUnderlineSingle
        .Font.Bold = True
        .TypeText Text:=Chr(124) & strTab & " - " & _
            Folder.Name & vbCrLf
        .Font.Bold = False
        .Font.Underline = wdUnderlineNone
    End With
    EnumFolders Folder.Path, intDepth + 1
    EnumFiles Folder.Path, intDepth + 1
Next Folder

strTab = ""

End Sub

Private Sub EnumFiles(strFolderPath, intDepth As Integer)

Dim Files, Folder, i

If intDepth <> 0 Then
    For i = 0 To intDepth
        strTab = strTab & vbTab
    Next i
Else
    strTab = ""
End If

Set Folder = objFSO.GetFolder(strFolderPath)
Set Files = Folder.Files

For Each File In Files
    If strTab <> "" Then
        Selection.TypeText Text:=Chr(124) & strTab & Chr(124) & _
            " - " & File.Name & vbCrLf
    Else
        Selection.TypeText Text:=Chr(124) & strTab & " - " & _
        File.Name & vbCrLf
    End If
Next File

strTab = ""

End Sub