Posts Tagged ‘VBA’

Optimizing/faster String Concatenation in VBA

Tuesday, June 9th, 2009

There are numerous links about Visual Basic string concatenation, one particular is Microsoft’s How To Improve String Concatenation Performance. But the article is overwritten for the point it is trying to make, so I will share a simplified example.

Lets say we want to perform the following concatenation:

Dim i As Long
Dim s As String
For i = 1 To 100000000
	s = "A" & i & "B"
Next i

This takes approximately 6000 ticks. The faster approach, yet more complex functionality would be as follows:

Dim sourceLength As Long
sourceLength = 1
Dim source As String
s = "A B"

Dim i As Long
Dim s As String
For i = 1 To 100000000
	source = CStr(i)
	If Len(source) > sourceLength Then
		sourceLength = Len(source)
		s = "A" & Space$(sourceLength) & "B"
	End If
	Mid$(s, 2, sourceLength) = source
Next i

Which takes approximately 3700 ticks, a saving of nearly 40%.

Word Minimize/Maximize event capture VBA

Friday, January 30th, 2009

Here is a quick little post outlining how to create a minimize/maximize event routine.

Add the following code to a class named EventClassModule

Public WithEvents App As Word.Application

Private Sub App_WindowDeactivate(ByVal Doc As Document, ByVal Wn As Window)
    If Doc.ActiveWindow.WindowState = wdWindowStateMinimize Then
        'you code in here
    End If
End Sub

and then add the following code under ThisDocument

Dim X As New EventClassModule

Private Sub Document_Open()
    'Call Register_Event_Handler
    Set X.App = Word.Application
End Sub

VBA automatically saves Excel 2003 Workbook in compatibility mode as Excel 2007 Workbook

Wednesday, July 2nd, 2008

Lets say you have a neat little Excel 2003 macro, when you run your macro in Excel 2007, Excel runs it in Compatibility Mode, and any benefits (such as the 16384 columns) you were hoping to use are still unavailable. So how can we enable these benefits depending on the Excel version? Simply by including the following code in the Auto_Open subroutine.

Public Sub auto_open()
'add some smarts if opened in Excel 2007 or later
Dim oldFileName As String
oldFileName = ThisWorkbook.Name
Dim tempi As Integer 'used to store position of '.' before file extension in workbook file name
tempi = InStrRev(oldFileName, ".xls", -1, vbTextCompare)
If Application.version > 11 And Len(oldFileName) - tempi = 3 Then 'assume running in compatability mode
Application.DisplayAlerts = False
Dim newFileName As String
newFileName = Mid$(oldFileName, 1, tempi) & "xlsm"
If fileExist(newFileName) Then 'if the new workbook version already exists, then open it and close this one
'open the new workbook by emulating double clicking the file, as this is the only way to run the auto_open
Shell "Excel """ & ThisWorkbook.Path & "\" & newFileName & """", 3 '3 = vbMaximizedFocus
'close this Excel application
Application.Quit
Else 'if the new workbook version doesn't exist, then save it as new workbook version
'save as macro enables office 2007 workbook
ActiveWorkbook.SaveAs fileName:=newFileName, FileFormat:=52, CreateBackup:=False '52 = xlOpenXMLWorkbookMacroEnabled
'create a timer to call the same new workbook as it will be now opened in non compatibility mode
Application.OnTime Now + TimeValue("00:00:01"), "auto_open"
Workbooks(newFileName).Close
End If
Application.DisplayAlerts = True
End If

UserForm1.Show
End Sub

Some brief info on how this works, so far the only way I have found to run in Non-Compatibility Mode is to save the Workbook as an Excel Macro Enabled Workbook and reopen the file, or if the file already exists then open that file and close the Excel 2003 Workbook. The main problem is the showing of a UserForm on the reopen or existing open. The bove code is the only way I have found so far, and it involves some trickery. It can be simplified if portions are separated into the Workbook_Activate subroutine, but I wanted to provide a copy and paste solution with minimal fiddling around. The only change in the above code is the UserForm1 name.

One of the problems was the Workbook_Activate or Auto_open not running when called via the normal Open method. I actually had to ask ExpertsExchange, the expert was very helpful.

Any comments or suggestions welcome as always.

Rigid file manipulation functions for VBA/VBS

Friday, December 14th, 2007

Ever since starting work I have been learning and using VBA/VBS to make life easier. I will start posting some of my generic functions as a source for others. They may not be written optimally, but they do work.

' Function: fileExist(sPathFile) returns True if a file exists
' Input: sPathFile - the file (including path) to determine if exists
' Output: fileExists - returns true if file exists
' Notes: network shared drives work as well.
Function fileExist(sPathFile) As Boolean
    On Error Resume Next
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fileExist = fso.FileExists(sPathFile)
    Set fso = Nothing
End Function

' Function: renameFile(oldName, newName) renames a file, can also be used to move a file
' Inputs: oldName - file including path to be renamed
'         newName - file including path of the renamed or moved file
' Notes: renameFile checks if the file exists and the new path exists before renaming or moving
' Dependants: fileExists
Function renameFile(oldName, newName)
    On Error Resume Next
    If fileExist(oldName) And Dir(Left(newName, InStrRev(newName, "/")), vbDirectory) <> vbNullString Then
        Dim fso
        Set fso = CreateObject("Scripting.FileSystemObject")
        fso.MoveFile oldName, newName
        Set fso = Nothing
    End If
End Function

' Function: deleteFile(sPathFile) deletes a file
' Input: sPathFile - the file (including path) to be deleted i.e. "C:/a.txt"
' Notes: deleteFile checks if the file exists first before deleting
' Dependants: deleteFile
Function deleteFile(sPathFile)
    On Error Resume Next
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(sPathFile) Then fso.GetFile(sPathFile).Delete
    Set fso = Nothing
End Function

' Function: copyFile(fileName, copyName) copies a file
' Inputs: fileName - file to be copied, path and file required i.e. "C:/a.txt"
'         copyName - the copied file, path and file required i.e. "C:/b.txt"
' Notes: copyFile checks if fileName exists, as well as the copyName folder
'        if copyName is already present the file is deleted
' Dependants: fileExists, deleteFile
Function copyFile(fileName, copyName)
    On Error Resume Next
    If fileExist(fileName) And Dir(Left(copyName, InStrRev(copyName, "/")), vbDirectory) <> vbNullString Then
        Call deleteFile(copyName)
        Dim fso
        Dim aFile
        Set fso = CreateObject("Scripting.FileSystemObject")
        fso.copyFile fileName, copyName, True
        Set aFile = fso.GetFile(copyName)
        If aFile.Attributes And 1 Then
            aFile.Attributes = aFile.Attributes - 1
        End If
        Set fso = Nothing
        Set aFile = Nothing
    End If
End Function