May 14th, 2012
The following function enable you to read in, for instance a text file, into memory to use within your routines.
'---------------------------------------------------------------------------------------
' Procedure : ReadFile
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Faster way to read text file all in RAM rather than line by line
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strFile - name of the file that is to be read
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' MyTxt = ReadText("c:\tmp\test.txt")
' MyTxt = ReadText("c:\tmp\test.sql")
' MyTxt = ReadText("c:\tmp\test.csv")
'---------------------------------------------------------------------------------------
Function ReadFile(ByVal strFile As String) As String
On Error GoTo Error_Handler
Dim FileNumber As Integer
Dim sFile As String 'Variable contain file content
'If FileExist(strFile) = False Then
' MsgBox "The specified file could not be found!"
' Exit Function
'End If
FileNumber = FreeFile
Open strFile For Binary Access Read As FileNumber
sFile = Space(LOF(FileNumber))
Get #FileNumber, , sFile
Close FileNumber
ReadFile = sFile
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ReadFile" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Functionc
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming | 
No Comments »
May 14th, 2012
I was asked in a support forum how to convert an Excel *.xls, *.xlsx file to *.csv format. I didn’t readily have an answer so I created a custom function to help the user out. So here are the fruits on my labors should it help someone else out. What is also nice about the way it is written, is that it will run in any MS Office application (MS Access, MS Word, MS PowerPoint, MS Outlook, …) without requiring any modifications (copy & paste, that’s it)!
'---------------------------------------------------------------------------------------
' Procedure : ConvertXls2CSV
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Converts a standard Excel file to csv format
' Requirements: Requires MS Excel be installed
' Uses late binding, so no libraries need be declared
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sXlsFile : Fully qualified path and filename with extension of the Excel workbook
'
' Usage:
' ~~~~~~
' ConvertXls2CSV "C:\Users\Daniel\Desktop\Contact_E-mail listing.xls"
' Will output a file C:\Users\Daniel\Desktop\Contact_E-mail listing.csv
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2012-May-11 Initial Release - Answer to forum question
'---------------------------------------------------------------------------------------
Function ConvertXls2CSV(sXlsFile As String)
On Error Resume Next
Dim oExcel As Object
Dim oExcelWrkBk As Object
Dim bExcelOpened As Boolean 'Was Excel already open or not
'Review 'XlFileFormat Enumeration' for more formats
Const xlCSVWindows = 23 'Windows CSV Format
Const xlCSV = 6 'CSV
Const xlCSVMac = 22 'Macintosh CSV
Const xlCSVMSDOS = 24 'MSDOS CSV
Set oExcel = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oExcel = CreateObject("excel.application")
bExcelOpened = False
Else 'Excel was already running
bExcelOpened = True
End If
On Error GoTo Error_Handler
oExcel.ScreenUpdating = False
oExcel.Visible = False 'Keep Excel hidden from the user
oExcel.Application.DisplayAlerts = False
Set oExcelWrkBk = oExcel.Workbooks.Open(sXlsFile)
'Note: you may wish to change the file format constant for another type declared
' above based on your usage/needs in the following line.
oExcelWrkBk.SaveAs Left(sXlsFile, InStrRev(sXlsFile, ".")) & "csv", xlCSVWindows
oExcelWrkBk.Close False
If bExcelOpened = False Then
oExcel.Quit
End If
Error_Handler_Exit:
On Error Resume Next
Set oExcelWrkBk = Nothing
Set oExcel = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ConvertXls2CSV" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End FunctionNow this could be further improved by extending the error handling further to trap specific errors such as 1004 – file not found, etc… but it definitely illustrates the basic principle in using late binding to utilize Excel to open the file and convert it to *.csv format.
I hope this helps.
MS Access - Excel Automation, MS Access - Outlook Automation, MS Access - Word Automation, MS Access VBA Programming, MS Excel VBA Programming, MS Office, MS Word VBA Programming | No Comments »
December 8th, 2011
I needed to ensure that no AutoFilters were set before running some other procedures. Below is a very simple sub routine that you can use do reset any, and all, AutoFilters within an Excel Workbook.
'---------------------------------------------------------------------------------------
' Procedure : ResetAutoFilters
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Resets all the AutoFilter in all the worksheets of the current workbook
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2011-December-07 Initial Release
'---------------------------------------------------------------------------------------
Sub ResetAutoFilters()
On Error GoTo Error_Handler
Dim w As Worksheet
For Each w In Worksheets
If w.FilterMode Then w.ShowAllData
Next w
Exit_Error_Handler:
Exit Sub
Error_Handler:
MsgBox "Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & vbCrLf & _
"Error Source: " & "ResetAutoFilters", vbCritical, "An Error Has Occured"
Resume Exit_Error_Handler
End SubSimilarily, if you wanted to reset the AutoFilter in one specific worksheet to display all the data, you could use a procedure such as:
'---------------------------------------------------------------------------------------
' Procedure : ResetAutoFilter
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Reset the AutoFilter in the specified worksheet of the active workbook
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' w - Worksheet
'
' Usage:
' ~~~~~~
' ResetAutoFilter sheets("Sheet1") ~ resets a specific sheet named Sheet1
' ResetAutoFilter sheets(6) ~ resets the 6th sheet in the workbook
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2011-Dec-07 Initial Release
'---------------------------------------------------------------------------------------
Sub ResetAutoFilter(w As Worksheet)
On Error GoTo Error_Handler
If w.FilterMode Then w.ShowAllData
Exit_Error_Handler:
Exit Sub
Error_Handler:
MsgBox "Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & vbCrLf & _
"Error Source: "ResetAutoFilter", vbCritical, "An Error Has Occured"
Resume Exit_Error_Handler
End Sub
MS Excel VBA Programming | No Comments »
November 15th, 2011
Have you ever wanted to setup your spreadsheet to print 1 page wide? It sounds like such a simple thing to do, and yet at first glance it appears not to be so easy in Excel’s VBA.
Now if you record a macro, or do some searching online, you’ll find that the method for setting up such settings using code, such as:
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 5
End WithThe problem being that you need to specify how many pages tall the document will be. Now I came across numerous post where people try to determine insert page breaks based on number of rows, or insert page breaks based on the height of rows, or I also came across posting stating to set the .FitToPagesTall to a extremely large number and Excel will automatically fit is properly.
Now, yes, these solutions will work, some requiring a lot more work than others, but as I found out, there is no need for such conveluted methods. One can merely set the .FotToPagesTall to False and Excel will resize according to fit the content by whatever value you specified in the .FitToPagesWide. So the finally code would merely be:
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = False 'Will take as many pages as required based on other settings
End WithInversly, you could specify the .FitToPagesWide and set the value of .FitToPagesTall to False and Excel will resize accordingly.
One more simple technique in your bag of tricks!
MS Excel VBA Programming | No Comments »
September 16th, 2011
It can often come handy to be able to quick determine if a Folder/Directory exists or not. Below is a function I created some time ago to do exactly that.
'---------------------------------------------------------------------------------------
' Procedure : FolderExist
' DateTime : 2009-Oct-02 13:51
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Test for the existance of a Folder/Directory
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFolder - Full path of the folder to be tested for
'---------------------------------------------------------------------------------------
Function FolderExist(sFolder As String) As Boolean
On Error GoTo Error_Handler
If sFolder = vbnullsring Then GoTo Error_Handler_Exit
If Dir(sFolder, vbDirectory) <> vbNullString Then
FolderExist = True
End If
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number <> 52 Then
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: FolderExist" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured
End If
Resume Error_Handler_Exit
End Function
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming | No Comments »
September 15th, 2011
One of he most common methods for creating directories/folders in VBA is to use the MkDir statement. For instance:
One quickly learns the limitations of this technique the minute they have to create a directory structure with multiple sub-folders. MkDir can only create 1 directory at a time and cannot create a sub-directory. Hence, assuming that C:\databases does not already exist, the following would not work and will return an error!
MkDir "C:\databases\msaccess\"
If you absolutely want to create such a structure using the MkDir statement you’d have to do so using 2 MkDir statement. For instance:
MkDir "C:\databases\"
MkDir "C:\databases\msaccess\"
Now if you need to merely create 1 or 2 sub-folder MkDir may still be acceptable, but there are cases where this is simply impracticle and another solution needs to be found. Well, I found two possible solutions!
One possible approach can be found at Creating Nested Directories.
The second I found searching through the net and I no longer know the original source of the code (if someone knows e-mail me and I will put credit where it is due). It is a simple API which can create multiple directories in 1 call.
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Public Sub MakeFullDir(strPath As String)
If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 'Optional depending upon intent
MakeSureDirectoryPathExists strPath
End SubAnother possible solution, if someone wanted to tinker a little would be to merely parse the path into it’s directories and the using the DIR statement evaluate and create the directories where need be. Shouldn’t be that hard, but I haven’t taken the time to do this (maybe one day I will and will update this post then).
Okay, so it bothered me and I had to quickly put something together to stop my brain from churning! Below is what I pieced together rapidly. It is missing proper variable definitions (DIM statements) and error handling, but from my very brief testing, it does appear to work and doesn’t require any APIs! 100% VBA.
Public Sub MyMkDir(sPath As String)
Dim iStart As Integer
Dim aDirs As Variant
Dim sCurDir As String
Dim i As Integer
If sPath <> "" Then
aDirs = Split(sPath, "\")
If Left(sPath, 2) = "\\" Then
iStart = 3
Else
iStart = 1
End If
sCurDir = Left(sPath, InStr(iStart, sPath, "\"))
For i = iStart To UBound(aDirs)
sCurDir = sCurDir & aDirs(i) & "\"
If Dir(sCurDir, vbDirectory) = vbNullString Then
MkDir sCurDir
End If
Next i
End If
End SubAs you can see, there are numerous way to handles this issue. Hopefully this helped answer a question for a few of you out there!
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming | 1 Comment »
June 22nd, 2011
I ran into a particular problem with an associate of mine not too long ago and thaught I’d share the problem & solution with everyone. He had been given an .accdb database that evidently came from an mdb originally as it contained a custom command bar. The problem being that 2007/2010 support such command bars by simply placing them in the Add-Ins tab. However, this issue lies with the fact that 2007/2010 no longer offer the general user/developer a method to edit such command bars as they are considered to be deprecated. My associate wanted to merely delete this command bar and replace it with a proper custom Ribbon Tab. So how do you delete a command bar? Good question! In 2007/2010 the only solution is to use VBA. The actual code to delete a command bar is very simple, as shown below.
Application.CommandBars("CommandBarName").DeleteSound simple you say. Sadly, no! Once again because MS has decided no longer provide any tools to work with these ‘elements’, you cannot identify the name of the Add-Ins toolbars. if you can’t identify it, you can’t delete it! So what to do? Well, I came up with another simple solution and created a procedure that merely listed all the command bars within the current database. then we could go through the list and identify the one that we needed to delete. Below are two slightly different procedures. The first one is a more general version which merely lists all of the command bars within the database, the second is a slightly more refined version that only lists open command bars. Since the Add-Ins Tab was active, the 2nd procedure was a better option in our case and thus reduce the list we had to sift through (our list went from 202 items to 4 – from there it was easy to determine which one we needed to eliminate).
'---------------------------------------------------------------------------------------
' Procedure : ListCmdBars
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Lists all the command bars within the current database
' Compatibility: Works with MS Access, Word, Excel, PowerPoint, ...
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2011-June-22 Initial Release
'---------------------------------------------------------------------------------------
Function ListCmdBars()
On Error GoTo Error_Handler
Dim i As Long
Dim sCmdBar As CommandBar
Debug.Print "Number", "Name", "Visible", "Built-in"
For i = 1 To Application.CommandBars.Count
Set sCmdBar = Application.CommandBars(i)
Debug.Print i, sCmdBar.Name, sCmdBar.Visible, sCmdBar.BuiltIn
Next i
Error_Handler_Exit:
On Error Resume Next
Set sCmdBar = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ListCmdBars" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
'---------------------------------------------------------------------------------------
' Procedure : ListVisibleCmdBars
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Lists all the visible command bars within the current database
' Compatibility: Works with MS Access, Word, Excel, PowerPoint, ...
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2011-June-22 Initial Release
'---------------------------------------------------------------------------------------
Function ListVisibleCmdBars()
On Error GoTo Error_Handler
Dim i As Long
Dim j As Long
Dim sCmdBar As CommandBar
Debug.Print "Number", "Name", "Visible", "Built-in"
For i = 1 To Application.CommandBars.Count
Set sCmdBar = Application.CommandBars(i)
If sCmdBar.Visible = True Then
j = j + 1
Debug.Print j, sCmdBar.Name, sCmdBar.Visible, sCmdBar.BuiltIn
End If
Next i
Error_Handler_Exit:
On Error Resume Next
Set sCmdBar = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ListVisibleCmdBars" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End FunctionSo as you can see, it is still possible to manipulate command bars in MS Access 2007/2010, but it can now only be done through the use of VBA code!
Thanks to a post by Albert Kallal, a fellow MVP, we also found out that it could be necessary to execute the following
CurrentDb.Properties.Delete("StartUpMenuBar") and in our case it was required as even after deleting the commandbar in question we were still receiving the error message
… can’t find the object ‘MyCommandBarName.’
If ‘MyCommandBarName’ is a new macro or macro group, make sure you have saved it and that you have type its name correctly
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming | No Comments »
June 8th, 2011
You can use the following procedure to extract the path from a full file name. You supply the file address, complete file path and file name (ie: “C:\Documents and Settings\User\Desktop\Details.txt”) and it will return the file name (ie: “Details.txt”)
'---------------------------------------------------------------------------------------
' Procedure : GetFileName
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Return the filename from a path\filename input
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFile - string of a path and filename (ie: "c:\temp\test.xls")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2008-Feb-06 Initial Release
'---------------------------------------------------------------------------------------
Function GetFileName(sFile As String)
On Error GoTo Err_Handler
GetFileName = Right(sFile, Len(sFile) - InStrRev(sFile, "\"))
Exit_Err_Handler:
Exit Function
Err_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GetFileName" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
GoTo Exit_Err_Handler
End Function
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming | No Comments »
June 7th, 2011
You can use the following procedure to extract the path from a full file name. You supply the file address, complete file path and file name (ie: “C:\Documents and Settings\User\Desktop\Details.txt”) and it will return the path (ie: “C:\Documents and Settings\User\Desktop\”)
'---------------------------------------------------------------------------------------
' Procedure : GetFilePath
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Return the path from a path\filename input
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFile - string of a path and filename (ie: "c:\temp\test.xls")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2008-Feb-06 Initial Release
'---------------------------------------------------------------------------------------
Function GetFilePath(sFile As String)
On Error GoTo Err_Handler
GetFilePath = Left(sFile, InStrRev(sFile, "\"))
Exit_Err_Handler:
Exit Function
Err_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GetFilePath" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
GoTo Exit_Err_Handler
End Function
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming | No Comments »
June 6th, 2011
Ever simply wanted to append data into an existing text file? The procedure below does exactly that. Simply supply the full path and file name of the text file to append to, and supply the string to append and voila!
'---------------------------------------------------------------------------------------
' Procedure : AppendTxt
' DateTime : 2007-Mar-06 10:14
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Output Data to an external file (*.txt or other format)
' ***Do not forget about access' DoCmd.OutputTo Method for
' exporting objects (queries, report,...)***
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFile - name of the file that the text is to be output to including the full path
' sText - text to be output to the file
'---------------------------------------------------------------------------------------
Function AppendTxt(sFile As String, sText As String)
On Error GoTo Err_Handler
Dim FileNumber As Integer
FileNumber = FreeFile ' Get unused file number
Open sFile For Append As #FileNumber ' Connect to the file
Print #FileNumber, sText ' Append our string
Close #FileNumber ' Close the file
Exit_Err_Handler:
Exit Function
Err_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: AppendTxt" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
GoTo Exit_Err_Handler
End Function
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming | No Comments »
June 5th, 2011
Here is another simple procedure that allows one to verify/check if a file exists or not.
'---------------------------------------------------------------------------------------
' Procedure : FileExist
' DateTime : 2007-Mar-06 13:51
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Test for the existance of a file; Returns True/False
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strFile - name of the file to be tested for including full path
'---------------------------------------------------------------------------------------
Function FileExist(strFile As String) As Boolean
On Error GoTo Err_Handler
FileExist = False
If Len(Dir(strFile)) > 0 Then
FileExist = True
End If
Exit_Err_Handler:
Exit Function
Err_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: FileExist" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
GoTo Exit_Err_Handler
End Function
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming | No Comments »
June 4th, 2011
It still amazes me how Microsoft can develop these complexe applications but seems to overlook some simple functions that they should included within them to aid developers… But then, as demonstrated with the release of Office 2007 and 2010, Microsoft is not interested in the developer, they are only interested in the end-user’s opinion. Not productivity (that went down, about 30-40% drop in efficiency, the tubes with their change of format)! So all that matters is looks, the feel – very superficial (rant over)!!!
This will be the first in a series of procedure that I will be posting in the coming months in which I hope to demonstrate how you can use the ‘Microsoft Visual Basic for Application Extensibility’ library in conjuntion with the power of VBA to learn more, control more, manipulate more the VBE.
In this first post, I simply wanted to create a simple procedure that would give me a breakdown of my Access project. I wanted to return a listing of procedure per module with a line count. As you can see, the ‘Microsoft Visual Basic for Application Extensibility’ enable us to perform this task with ease with little code. Heck, half of the code below is to write to the generated text file!
'---------------------------------------------------------------------------------------
' Procedure : GetVBEDeatils
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Goes throught the VBE and creates a text file which give a brief listing
' of the procedures within each module and a line count for each
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
' Requirements: reference to the Microsoft Visual Basic for Application Extensibility
' library.
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2011-June-04 Initial Release
'---------------------------------------------------------------------------------------
Function GetVBEDeatils()
Dim vbProj As VBProject
Dim vbComp As VBComponent
Dim vbMod As CodeModule
Dim sProcName As String
Dim pk As vbext_ProcKind
Dim FileNumber As Integer
Dim strFile As String
Const vbNormalFocus = 1
'Where do youwant the text file created
strFile = "C:\VBEDetails.txt"
If Len(Dir(strFile)) > 0 Then Kill strFile
FileNumber = FreeFile 'Get unused file number.
Open strFile For Append As #FileNumber 'Create file name.
For Each vbProj In Application.VBE.VBProjects 'Loop through each project
Print #FileNumber, vbProj.Name
For Each vbComp In vbProj.VBComponents 'Loop through each module
Set vbMod = vbComp.CodeModule
Print #FileNumber, " " & vbComp.Name & " :: " & vbMod.CountOfLines & " total lines"
Print #FileNumber, " " & String(80, "*")
iCounter = 1
Do While iCounter < vbMod.CountOfLines 'Loop through each procedure
sProcName = vbMod.ProcOfLine(iCounter, pk)
If sProcName <> "" Then
Print #FileNumber, " " & sProcName & " :: " & vbMod.ProcCountLines(sProcName, pk) & " lines"
iCounter = iCounter + vbMod.ProcCountLines(sProcName, pk)
Else
iCounter = iCounter + 1
End If
Loop
Print #FileNumber, ""
Next vbComp
Next vbProj
Close #FileNumber 'Close file.
Set vbMod = Nothing
'Open the generated text file
Shell "cmd /c """ & strFile & """", vbNormalFocus
End Function
MS Access, MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming | 1 Comment »
May 18th, 2011
I had been needing to find an easy way to determine the last used row in a given column, or possibly the next availble row in a column. I search Google and found numerous examples, which I used for a short period of time. Code such as:
Range("A65536").End(xlup).SelectBut that code was not 100% reliable and I wanted, as much as possible, to avoid useless .Select statement to try and optimize my code as best I could. Well, I finally managed to get it down to a single line of code without the use of any .Select statements and which is flexible regardless of the version of Excel being used. See my code below:
Dim iLastRow As Long
Dim iNextAvailableRow As Long
iLastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
iNextAvailableRow = iLastRow +1
The only thing you need to know to use this code is that the 1 in (Rows.Count, 1) represents the columns to determine the last used row in. Hence 1=Column A, 2=Column B, …
MS Excel VBA Programming | No Comments »
