Thursday, April 01, 2010

How to tell if a file is a Word document

I am building a tool that needs to do something to all the Word documents in a set of folders. There are other sorts of files in these folders so I need to filter the list. I didn't want to hard code the file extensions that constitute Word documents because these change according to the version and will do so in future. So I decided to develop a function that is cross-version compatible.

To determine the documents that Microsoft Word can open and update natively, I am using the Filters collection from the Application.FileDialog object which is available in Word version 2002 onwards. This is the list of extensions that can be selected in the File Open dialog to filter the files that can be opened in Word. Seems to work like a charm. For earlier versions, you'll need to hardcode the extensions.


Public Function IsWordDocument(ByVal strExtension As String) As Boolean

    ' Developed by Warren Bain on 01/04/2010
    ' Copyright (c) Thought Croft Pty Ltd
    ' All rights reserved.

    ' Verifies if the supplied file extension e.g. "doc"
    ' is recognised as one of the documents that this version
    ' of Word can natively handle.  List is constructed from the
    ' types of documents that can be filtered in the Open File dialog
    ' therefore this only works from Microsoft Word 2002 onwards.

    Const strcNoiseChars           As String = "*?."
    Const strcSeparators           As String = ";,"
    Const strcDelimiter            As String = "|"

    Static colExtensions           As Collection

    Dim fdf                        As FileDialogFilter
    Dim astrExts                   As Variant
    Dim strExts                    As String
    Dim i                          As Integer

    ' Check if we have loaded the collection yet - only done once
    If colExtensions Is Nothing Then
        Set colExtensions = New Collection
        For Each fdf In Application.FileDialog(msoFileDialogOpen).Filters
            strExts = fdf.Extensions

            ' Remove any 'noise' characters from the string
            For i = 1 To Len(strcNoiseChars)
                strExts = Replace(strExts, Mid$(strcNoiseChars, i, 1), vbNullString)
            Next i

            ' Ensure we standardise on separators used
            For i = 1 To Len(strcSeparators)
                strExts = Replace(strExts, Mid$(strcSeparators, i, 1), strcDelimiter)
            Next i

            ' Turn the current set of extensions into an array
            astrExts = Split(strExts, strcDelimiter)

            ' Add all the ones we haven't already got
            For i = LBound(astrExts) To UBound(astrExts)
                ' If already there, this will fail so ignore
                On Error Resume Next
                colExtensions.Add Trim(astrExts(i)), Trim(astrExts(i))
                On Error GoTo 0
            Next i
        Next fdf
    End If

    ' We just try and look up the file type and if it fails
    ' then it is not an intrinsically supported document
    On Error Resume Next
    strExts = colExtensions.Item(strExtension)
    IsWordDocument = (Err = 0)
End Function

Friday, February 26, 2010

Handling strings containing quotes properly in SQL

Everyone is aware that quotes in strings used in SQL cause all sorts of problems. As a developer, it is our duty to ensure that an end user never sees an SQL error because we didn't handle his input appropriately! But how the heck do you ensure that quotes are handled correctly? The following function will take a string and return it enclosed with quotes and all instances of quotes in the string will be doubled up. This will work in SQL.

For example if I call QuotedString("This is a "string" example") then it will return:

"This is ""a string"" example"


Public Function QuotedString( _
strText As String) As String

Const conQuoteChar = """"

QuotedString = conQuoteChar _
& Replace$(strText, conQuoteChar, conQuoteChar & conQuoteChar) _
& conQuoteChar
End Function

Thursday, April 30, 2009

INDIRECT() function in Excel

This is not a VBA issue but a recent discussion on LinkedIn brought up the question of how to use INDIRECT to construct a reference to a named range in an external sheet. I have been using this very useful function for years to programmatically construct references based on different parameters which resolve to a specific workbook, sheet, name etc. Here is some information on how to properly construct a text based reference.

INDIRECT returns a reference specified by a text string and the syntax is INDIRECT(ref_text [, a1]) where ref_text is a reference to a cell containing an A1-style reference, an R1C1-style reference, a name defined as a reference or a reference to a cell as a text string. An error in the reference returns #REF!. a1 specifies the type of reference and for TRUE or omitted means A1-style and FALSE means R1C1 style.

The INDIRECT function will return #REF! if the target workbook is not open at the time you open the source workbook (closing the target after it has been open doesn't cause this error as Excel remembers the value until you force a recalc).

The proper construction of a text string based reference is as follows:
'path[file]sheet'!range
where the literal characters apostrophe ', square brackets [] and exclamation mark ! delimit the following
  • path = drive and folder where the file exists. If you leave this out then it will use the workbook named file you have open no matter its location on disk. If the path has a folder with spaces in it then you must use the apostrophes.
  • file = the name of the file with extension. Use of the apostrophes means that this name can have spaces in it. If you leave out the apostrophes then no spaces are allowed!
  • sheet = the name of the worksheet. Only use the "[]" delimiters if a sheet name is provided. No sheet name, no brackets around file!
If you don't provide a sheet name then the reference will default to the first sheet in the workbook. For a named range, no sheet will work if the named range has a scope of workbook or a scope of the first sheet. Obviously, if you provide a sheet for a named range then it must have a scope of that sheet or the reference doesn't exist and returns #REF!

I hope this is helpful to folks that are confused about this very useful function.

Wednesday, April 15, 2009

Project Holiday Import Wizard

Check out this VBA enabled Microsoft Project Plan document that I recently developed. It neatly solves a need of every project manager who uses Microsoft Project to track their project: marking public holidays as non-working time in the project schedule.

My approach is to use the Outlook Holiday File that is installed on your computer when you install Microsoft Office Outlook. It contains hundreds of religious and national holidays from countries around the world. If you don't have Outlook installed, the wizard will take you to a page where you can learn about this file and download a copy to use as a source of holiday dates.

Best of all: its free!

Click here to visit my company website and check it out.

Wednesday, January 28, 2009

Possible Error in Excel 2007 Workbooks.Open method

I have discovered a disturbing "feature" in Excel 2007 VBA in the way that the Workbooks.Open method handles xlsx format files versus the legacy xls format file.

If a file has a "workbook protection" password set, then the following statement will succeed for an xls file but will fail for an xlsx file with run time error "1004: The password you supplied is not correct."

set wkb = Application.Workbooks.Open("file.???", , , , "password")

Why supply a password in this call? I am running Excel as an unattended automation server to load data captured in workbooks submitted from a website into an Access database. Sometimes the users apply a "file open" password which will cause Excel to display a dialog box and wait for someone to supply the password if no password is supplied as an argument to the Open method - very bad! On the other hand, if the password argument is present and is incorrect then the above 1004 error is generated and I can then deal with it in code. If there isn't a "file open" password on the file, the Open method ignores the password argument.

However, all my files have a "workbook protection" password set and some users submit the files in the new xlsx format. This causes me to discard the file when it should be able to be opened. By the way, even if the "workbook protection" password is "password" it generates this error. And if there is a "workbook protection" password on an xlsx file and no password argument is provided to the Open method, it opens the file without any trouble.

So looks like Microsoft have messed up the Workbooks Open method in the case where:
  1. The file has a "workbook protection" password
  2. The file is in the new xlsx format
  3. A password argument is supplied in the call to the Workbooks.Open method
If you know someone who can alert Microsoft to this, please let them or me know!

*** UPDATE ***

Prominent Excel MVP Ron de Bruin has confirmed this is an error and has notified the Microsoft Excel team. Stay tuned for additional developments.

*** UPDATE ***

Wednesday, August 27, 2008

IsFileOpen

If you ever need to determine if a file is already open before you attempt to do something with it in VBA, you will discover a blistering array of code segments on the interweb which all seem to share the characteristic that: they fail to work as advertised.

So time for me to add my version and I can state that it absolutely works except where the opening application fails to lock the file. AFAIK, that comment applies to text files opened in Notepad and any file opened with an Office application that has its read-only attribute set. However, since the main reason for testing if a file is already open is so that you can do stuff to it without it causing a "file is already in use" type of error, these two conditions don't matter since they don't stop you doing anything with the file. If you don't believe me, try this:
  • Create an Excel file "test.xls"
  • In Windows Explorer right click on the file and mark it as "read-only"
  • Open the file in Excel
  • Now go back to Windows Explorer and delete the file
  • Voila! No problem since it was read-only, Excel opened a temporary copy of the file and so you do stuff to the original without it causing any problems.
Now, back to the problem: how do you tell if a given file is in use?
Answer: use the VBA "open" statement to exclusively open the file and trap any errors that may occur. We have to go one further though as the "open" statement will not see any hidden files and will act as though they don't exist. To overcome this we make some attribute changes and trap any errors that may occur in relation to them as well. See code below.

Public Function IsFileOpen(ByVal strFullPathFileName As String) As Boolean

' Attempting to open a file for ReadWrite that exists will fail
' if someone else has it open. We also have to guard against the
' errors that occur if the file has uncommon file attributes such as
' 'hidden' which can upset the Open statement.
' NOTE: any open that doesn't lock the file such as opening a .txt file
' in NotePad or a read-only file open will return False from this call.

Dim lngFile As Long
Dim intAttrib As Integer

On Error Resume Next
intAttrib = GetAttr(strFullPathFileName)
If Err <> 0 Then
' If we can't get these then it means the file name is
' invalid, or the file or path don't exist so no problem
IsFileOpen = False
Exit Function
End If

SetAttr strFullPathFileName, vbNormal
If Err <> 0 Then
' An error here means that the file is open and the attributes
' therefore can't be changed so let them know that
IsFileOpen = True
Exit Function
End If

' Ready to try and open the file exclusively and then any error means that
' the file is already open by some other process...
lngFile = FreeFile
Open strFullPathFileName For Random Access Read Write Lock Read Write As lngFile
IsFileOpen = (Err <> 0)
Close lngFile

' Restore the attributes and exit
SetAttr strFullPathFileName, intAttrib

End Function

Monday, June 30, 2008

Set Follow Up Flag Icon For Unsent Mail

I am a big fan of the Follow Up Flag Icon (the coloured flags)in Outlook 2003 because it simplifies tracking all the important stuff that I have to do. By adding a coloured Flag Icon to email I can use the special For Follow Up search folder to just display the emails that I want to focus on. I also use Trog by Priacta which also uses these flags. But there is a problem (of course) and that is that Outlook won't allow me to set a Follow Up Flag Icon for an unsent email.

Well, I want to be able to do that so that I keep track of email that I have sent to people that I need to follow up on. I can send the email, then go to my Sent folder and then add the appropriate coloured flag but that is inefficient and just plain annoying. I don't send mail immediately anyway, so I have to use F9 and wait a bit or wait longer and remember to go and do it.

However after a bit of testing, I discovered that you can programmatically set the FlagIcon. But I didn't want to replace the inbuilt function completely, nor did I want to add another button to the commandbar. So I decided that I needed to be able to trap the button click and pop up my own form whenever I was looking at an unsent email. The trick is to sink the appropriate events using a class module.

Obviously, you can use these concepts to manage any number of tasks and in my example the form could be expanded to replace all of the functionality in Follow Up. I leave that to the reader as an exercise...

First, I designed a simple UserForm called frmSetFlagIcon. Here is an example, it doesn't take long to knock one up (email me if you want a copy sent to you).


Next, add the following code to the UserForm (make sure you use the same names for the controls or modify accordingly):

' frmSetFlagIcon

' Developed by Warren Bain on 30/06/2008
' Copyright (c) Thought Croft Pty Ltd
' All rights reserved.

' This module allows me to set the Follow Up Flag colour
' for unsaved new email which I want to do so I can track
' emails that I send and need to follow up using TROG by Priacta

Option Explicit

' -----------------
' Module variables
' -----------------

Dim moMail As MailItem
Dim mblnSent As Boolean
Dim moFlagStatus As OlFlagStatus
Dim moFlagIcon As OlFlagIcon

' -----------------
' Module procedures
' -----------------

Private Sub cboFlagIcon_Change()

' If we have unset the flag then the
' FlagStatus must be set appropriately

If IsNull(Me.cboFlagIcon) Then
moFlagIcon = olNoFlagIcon
Else
moFlagIcon = Me.cboFlagIcon
End If
If moFlagIcon = olNoFlagIcon Then
moFlagStatus = olNoFlag
Else
moFlagStatus = olFlagMarked
End If
Call DisplayControls

End Sub

Private Sub ckbCompleted_Change()

' If they mark it complete then alter
' FlagStatus accordingly

If Me.ckbCompleted Then
moFlagStatus = olFlagComplete
Else
moFlagStatus = olFlagMarked
End If
Call DisplayControls

End Sub

Private Sub cmdCancel_Click()

' Clear global object and close form

Set moMail = Nothing
Unload Me

End Sub

Private Sub cmdOK_Click()

If Not moMail Is Nothing Then
With moMail
If moFlagIcon <> .FlagIcon Or moFlagStatus <> .FlagStatus Then
' They altered something so update MailItem
.FlagStatus = moFlagStatus
.FlagIcon = moFlagIcon
.Save
End If
End With
End If

Set moMail = Nothing
Unload Me

End Sub

Private Sub UserForm_Initialize()

' Set up the different colours available
' to us when the form is first opened
' The two arrays must be kept
' in step and in the order required

Dim astrColours As Variant
Dim avarFlagIcons As Variant
Dim i As Integer
Dim oInsp As Inspector
Dim oItem As Object


With Me.cboFlagIcon
astrColours = Array("No flag set", "Red", "Blue", _
"Yellow", "Green", _
"Orange", "Purple")
avarFlagIcons = Array(olNoFlagIcon, olRedFlagIcon, olBlueFlagIcon, olYellowFlagIcon, _
olGreenFlagIcon, olOrangeFlagIcon, olPurpleFlagIcon)
For i = LBound(astrColours) To UBound(astrColours)
.AddItem
.List(i, 0) = avarFlagIcons(i)
.List(i, 1) = astrColours(i)
Next i
End With

' Now see which mail item is being referenced
' and prepare ourselves for working with it
Set oInsp = Application.ActiveInspector
If Not oInsp Is Nothing Then
Set oItem = oInsp.CurrentItem
If TypeOf oItem Is MailItem Then
' We have a mail item to work with so
' retrieve the current flag settings
Set moMail = oItem
With moMail
mblnSent = .Sent
moFlagStatus = .FlagStatus
moFlagIcon = .FlagIcon
End With
Me.ckbCompleted = (moFlagStatus = olFlagComplete)
Me.cboFlagIcon = moFlagIcon
End If
End If

Set oItem = Nothing
Set oInsp = Nothing

End Sub

Private Sub DisplayControls()

' Ensure that the controls are enabled
' consistently with their settings

If Not moMail Is Nothing Then

' Only allow OK if they have actually altered the
' controls to be different from the MailItem
With moMail
Me.cmdOK.Enabled = moFlagIcon <> .FlagIcon _
Or moFlagStatus <> .FlagStatus
End With

' Allow them to set Completed if the flag is set and SENT
' and allow Flag Icon change if incomplete
Me.cboFlagIcon.Enabled = Not Me.ckbCompleted
Me.ckbCompleted.Enabled = (Me.cboFlagIcon <> olNoFlagIcon) And mblnSent

End If

End Sub

Next, add a new class module to the Outlook Project to sink the events we are interested in. Essentially this will trap any click on the Add Reminder... menu item under Actions | Follow Up submenu, or click the Follow Up button on the Standard menubar, our form will be displayed instead of the inbuilt Outlook one. Name the class module clsInspectorHandler and paste this code into it.

Note that this will be instantiated for any Inspector that we are interested in and so we have to have a way of determining if a button click is for this instance of the Inspector object. We generate a unique key and set it in the button's Tag property. When the button is clicked on one Inspector, every CommandBarControl object referencing that button will have its Click event fired, so the instance ignores any for Controls that don't have its unique tag set in it.

' clsInspectorHandler

' Developed by Warren Bain on 30/06/2008
' Copyright (c) Thought Croft Pty Ltd
' All rights reserved.

Option Explicit

Dim WithEvents oInspector As Outlook.Inspector
Dim WithEvents oCBB1 As Office.CommandBarButton
Dim WithEvents oCBB2 As Office.CommandBarButton
Dim mstrUniqueTag As Integer

Private Sub Class_Initialize()
' Create a unique key for tag usage
Randomize
mstrUniqueTag = Int((9999 - 0 + 1) * Rnd + 0)
End Sub

Private Sub Class_Terminate()
Set oCBB1 = Nothing
Set oCBB2 = Nothing
Set oInspector = Nothing
End Sub

Private Sub oCBB1_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
' We want to prevent this one from running and load our own
If Ctrl.Tag = mstrUniqueTag Then
frmSetFlagIcon.Show
CancelDefault = True
End If
End Sub

Private Sub oCBB2_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
' We want to prevent this one from running and load our own
If Ctrl.Tag = mstrUniqueTag Then
frmSetFlagIcon.Show
CancelDefault = True
End If
End Sub

Private Sub oInspector_Close()
Set oCBB1 = Nothing
Set oCBB2 = Nothing
End Sub

Public Sub SetInspector(Inspector As Outlook.Inspector)
If Not Inspector Is Nothing Then
Set oInspector = Inspector
With oInspector
' 1678 = Standard menu button "Follow &Up"
' 7478 = Action menu Follow Up submenu item "&Add Reminder..."
Set oCBB1 = .CommandBars.FindControl(msoControlButton, 1678)
oCBB1.Tag = mstrUniqueTag
Set oCBB2 = .CommandBars.FindControl(msoControlButton, 7478)
oCBB1.Tag = mstrUniqueTag
End With
End If
End Sub

NOTE: the CommandBarControlButton ids that I have quoted are correct in my installation of Outlook 2003. You will need to check they are the same for your version. Sue Mosher has code that will allow you to enumerate all CommandBars in Outlook.

Then add the following code in the ThisOutlookSession module. When a new Inspector is opened (for example to compose an email), the NewInspector event will fire. If it is for an Unsent MailItem, we are interested in trapping the relevant button clicks so we create a new instance of the clsInspectorHandler, add it to a global collection object to keep it alive (as there may be multiple Inspectors open at any one time, we have to keep an instance for each one) and then call its SetInspector method to sink the required Click events.

Public WithEvents colInspectors As Outlook.Inspectors
Public gcolMyInspectors As Collection

Private Sub Application_Quit()
Set gcolMyInspectors = Nothing
Set colInspectors = Nothing
End Sub

Private Sub Application_Startup()
Set gcolMyInspectors = New Collection
Set colInspectors = Application.Inspectors
End Sub

Private Sub colInspectors_NewInspector(ByVal Inspector As Inspector)

' This will be called everytime we open
' a new Inspector, so check if this is
' one that we want to monitor

Dim MyInspectorHandler As clsInspectorHandler

If Inspector.CurrentItem.Class = olMail Then
If Not Inspector.CurrentItem.Sent Then
' This is an unsent email so we want to
' trap the buttons that can be clicked
Set MyInspectorHandler = New clsInspectorHandler
Call MyInspectorHandler.SetInspector(Inspector)
gcolMyInspectors.Add MyInspectorHandler
End If
End If
End Sub

Save the project, restart Outlook and you will be in business. Anytime you want to flag an unsent email, your form will popup in place of the Outlook inbuilt one.