Tuesday, March 18, 2014

The day of reckoning has come: Upgrading Excel 2003 VBA code to Excel 2010.

At work we have a few Excel spreadsheets which read data files and processes them into a specific worksheet format. One of the problems with upgrading to Excel 2010 has been that many of the VBA functions used in our macros have been removed. Here is one example of code that does not work in Excel 2010.

Excel 2003 Code:
Set fs = Application.FileSearch
    With fs
        .NewSearch
        .LookIn = vrtSelectedItem
        .SearchSubFolders = True
        .Filename = "Macro_I"
        .MatchExactly = False
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                Call StuffCore(.FoundFiles(i), summaryType)
            Next i
        End If
    End With

The problem is that Application.FileSearch no longer exists in Excel 2010. Therefore a replacement for this function needed to be found. Others have had the same problem and posted a replacement function here.

The previous code snippet now becomes the following.

Excel 2010 Code:
Dim foundFiles() As FoundFileInfo
Dim foundFilesCount As Integer
searchPattern = "Macro_I*"
recursiveSearch = True
Dim boolFoundFiles As Boolean

boolFoundFiles = FindFiles(vrtSeclectedItem, foundFiles, foundFilesCount, searchPattern, recursiveSearch)

If boolFoundFiles = True Then
    For i = 1 To foundFilesCount
        With foundFiles(i)
            Call StuffCore(.sPath & .sName, summaryType)
        End With
    Next i
End If

For this code to work a new data type must be declared globally outside of all subroutines. This is the "FoundFileInfo" type and it is created with the following code.

FoundFileInfo type declaration:
 Type FoundFileInfo
    sPath As String
    sName As String
End Type

And the "FindFiles" function is defined as follows.

 FindFiles function definition:

Function FindFiles(ByVal sPath As String, _
    ByRef recFoundFiles() As FoundFileInfo, _
    ByRef iFilesFound As Integer, _
    Optional ByVal sFileSpec As String = "*.*", _
    Optional ByVal blIncludeSubFolders As Boolean = False) As Boolean
'
' FindFiles
' ---------
' Finds all files matching the specified file spec starting from the specified path and
' searches sub-folders if required.
'
' Parameters
' ----------
' sPath (String): Start-up folder, e.g. "C:\Users\Username\Documents"
'
' recFoundFiles (User-defined data type): a user-defined dynamic array to store the path
' and name of found files. The dimension of this array is (1 To nnn), where nnn is the
' number of found files. The elements of this array are:
'   .sPath (String) = File path
'   .sName (String) = File name
'
' iFilesFound (Integer): Number of files found.
'
' sFileSpec (String): Optional parameter with default value = "*.*"
'
' blIncludeSubFolders (Boolean): Optional parameter with default value = False
'   (which means sub-folders will not be searched)
'
' Return values
' -------------
' True: One or more files found, therefore
'   recFoundFiles = Array of paths and names of all found files
'   iFilesFound = Number of found files
' False: No files found, therefore
'   iFilesFound = 0
'
' Using the function (sample code)
' --------------------------------
'    Dim iFilesNum As Integer
'    Dim iCount As Integer
'    Dim recMyFiles() As FoundFileInfo
'    Dim blFilesFound As Boolean
'
'    blFilesFound = FindFiles("C:\Users\MBA\Desktop", _
'        recMyFiles, iFilesNum, "*.txt?", True)
'    If blFilesFound Then
'        For iCount = 1 To iFilesNum
'            With recMyFiles(iCount)
'                MsgBox "Path:" & vbTab & .sPath & _
'                    vbNewLine & "Name:" & vbTab & .sName, _
'                    vbInformation, "Found Files"
'            End With
'        Next
'    Else
'  MsgBox "No file(s) found matching the specified file spec.", _
'            vbInformation, "File(s) not Found"
'    End If
'
'
' Constructive comments and Reporting of bugs would be
' appreciated.

    Dim iCount As Integer           '* Multipurpose counter
    Dim sFileName As String         '* Found file name
    '*
    '* FileSystem objects
    Dim oFileSystem As Object, _
        oParentFolder As Object, _
        oFolder As Object, _
        oFile As Object

    Set oFileSystem = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set oParentFolder = oFileSystem.GetFolder(sPath)
    If oParentFolder Is Nothing Then
        FindFiles = False
        On Error GoTo 0
        Set oParentFolder = Nothing
        Set oFileSystem = Nothing
        Exit Function
    End If
    sPath = IIf(Right(sPath, 1) = "\", sPath, sPath & "\")
    '*
    '* Find files
    'sPath = sPath & sFileSpec
    sFileName = Dir(sPath & sFileSpec, vbNormal)
    If sFileName <> "" Then
        For Each oFile In oParentFolder.Files
            If LCase(oFile.Name) Like LCase(sFileSpec) Then
                iCount = UBound(recFoundFiles)
                iCount = iCount + 1
                ReDim Preserve recFoundFiles(1 To iCount)
                With recFoundFiles(iCount)
                    .sPath = sPath
                    .sName = oFile.Name
                End With
            End If
        Next oFile
        Set oFile = Nothing         '* Although it is nothing
    End If
    If blIncludeSubFolders Then
        '*
        '* Select next sub-forbers
        For Each oFolder In oParentFolder.SubFolders
            FindFiles oFolder.Path, recFoundFiles, iFilesFound, sFileSpec, blIncludeSubFolders
        Next
    End If
    FindFiles = UBound(recFoundFiles) > 0
    iFilesFound = UBound(recFoundFiles)
    On Error GoTo 0
    '*
    '* Clean-up
    Set oFolder = Nothing   '* Although it is nothing
    Set oParentFolder = Nothing
    Set oFileSystem = Nothing

End Function


Another database stuffing macro needed a syntax change for the Sort method. The old code looked like this:

Old range sorting code:

' Define the range for the sort
Range("A" & SortStart & ":" & "BH" & SortEnd).Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, _
Header := xlNo, custom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

New range sorting code:

With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
   .SortFields.Clear
   .SortFields.Add Key:=Range("B1"), _
       SortOn:=xlSortOnValues, Order:=xlAscending, _
       DataOption:=xlSortNormal
    .SetRange Range("A" & SortStart & ":" & "BH" & SortEnd)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .Apply
End With

Who knows what else we will need to fix. We have a dozen or so more macro to test on Excel 2010. I will keep taking notes here for future reference. 

No comments:

Post a Comment