MS Access VBA – DoCmd.TransferSpreadsheet Error 3190 – Too many fields

A quick word of caution regarding the Error code 3190 that may occur when using the DoCmd.TransferSpreadsheet Method to export data. I previously had been using a procedure to export my data without any problems, then I went to use it again and kept getting this error. I mean I only had 12 columns in my query, so what the …?! After doing some testing I ended up determining that it had nothing to do with the field count, but rather with the fact that the file already existed. Basically, the DoCmd.TransferSpreadsheet Method was unable to overwrite the existing file and raised this most useless error!

So beware that Error 3190 – Too many fields can also mean cannot overwrite the existing export file. The fix is extremely easy, simply check for the file and if it does exist then delete it using the Kill statement prior to running the DoCmd.TransferSpreadsheet Method.

Continue reading

VBA – Using Regular Expressions (RegEx)

One of the most powerful features of many other programming languages is their ability to utilize Regular Expressions (RegEx) for finding patterns… to manipulate and/or extract data from strings.

Sadly however, VBA does not have the ability to use them, well at least not natively! Thankfully, it really is not very complicated to be able to integrate RegEx into one any VBA procedure by simply creating a VBScript object (since VBScript does support RegEx).

The basic idea goes something like:

Set oRegEx = CreateObject("VBScript.RegExp")
oRegEx.Pattern = "YourRegEx Goes Here"
bResult = oRegEx.Test(YourStringToTestTheRegExWith)

Instead of just testing, you can .Execute, .Replace… Lots of fun things you can do with RegEx.

Continue reading

MS Access VBA – FileName of the Current Database

Here’s how you can determine the filename of the current database, simply use the following line of code:

Application.CurrentProject.Name

It will return a string value like: ‘Access_Solution_Center.mdb’

MS Access VBA – Path of the Current Database

If all you wish is to determine the path of the current database, simply use the following line of code:

Application.CurrentProject.Path

It will return a string value like: ‘D:\MS Access\References’

Pay particular attention to the fact that it does not include the closing slash in the string it returns. So if you are going to use it in your code, remember to concatenate it with a closing slash by simply doing something like:

Application.CurrentProject.Path & "\"

MS Access – Phone Number Format

Although one can easily use an input mask to format value, including phone numbers. It became necessary for me to be able to do the same type of formatting but directly through VBA. Below is a simple routine, but hopefully it will help you.

This procedure becomes very useful when you need to deal with phone numbers from varying regions. If you only will ever deal with a preset phone number format then I recommend using the input mask. However, if you will need to accommodate and format all sorts of international phone number formats the procedure is the way to go and you can easily add new format to it by simply adding new Case statement clauses.

'---------------------------------------------------------------------------------------
' Procedure : FormPhone
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Format a string into a formatted phone number
' 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:
' ~~~~~~~~~~~~~~~~
' sPhone    : a raw phone number string (ie:5555555)
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' FormPhone("5555555")      -->>    555-5555
' FormPhone("5555555555")   -->>    (555)555-5555
' FormPhone("55555555555")  -->>    5(555)555-5555
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2009-Feb-13             Initial Release
' 2         2010-Jan-26             Expanded code to format 10 and 11 char phone no.
'---------------------------------------------------------------------------------------
Function FormPhone(sPhone As String) As String
On Error GoTo Error_Handler
    Dim sIni        As String
    Dim sArea       As String
    Dim sPNumber    As String
    Dim isPhoneLen  As Integer
    
    'Make sure we actually have a value to process
    If sPhone = "" Or IsNull(sPhone) Then
        sPhone = ""
        Exit Function
    End If
    
    sPhone = Trim(sPhone)    'Remove any leading or trailing white spaces
    isPhoneLen = Len(sPhone) 'Determine the length of the raw tel no.
    Select Case isPhoneLen
        Case 7  '555-5555
            FormPhone = Left(sPhone, 3) & "-" & Right(sPhone, Len(sPhone) - 3)
        Case 10 '(555)555-5555
            sArea = "(" & Left(sPhone, 3) & ") "
            sPNumber = Right(sPhone, Len(sPhone) - 3)
            FormPhone = sArea & Left(sPNumber, 3) & "-" & _
                        Right(sPNumber, Len(sPNumber) - 3)
        Case 11 '5(555)555-5555
            sIni = Left(sPhone, 1)
            sArea = "(" & Left(Right(sPhone, Len(sPhone) - 1), 3) & ") "
            sPNumber = Right(sPhone, Len(sPhone) - 4)
            FormPhone = sIni & sArea & Left(sPNumber, 3) & _
                        "-" & Right(sPNumber, Len(sPNumber) - 3)
        Case Else
            FormPhone = sPhone
    End Select
    
Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & "Error Source: FormPhone" & _
           vbCrLf & "Error Description: " & Err.Description, vbCritical, _
           "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

 

Updated 2011-04-14

Below you will find another approach to formatting phone numbers.

Function StripAllChars(strString As String) As String
'Return only numeric values from a string
    Dim lngCtr      As Long
    Dim intChar     As Integer

    For lngCtr = 1 To Len(strString)
        intChar = Asc(Mid(strString, lngCtr, 1))
        If intChar >= 48 And intChar <= 57 Then
            StripAllChars = StripAllChars & Chr(intChar)
        End If
    Next lngCtr
End Function

Function FormatPhone(strIn As String) As Variant
On Error Resume Next

    strIn = StripAllChars(strIn)
    
    If InStr(1, strIn, "@") >= 1 Then
        FormatPhone = strIn
        Exit Function
    End If
    
    Select Case Len(strIn & vbNullString)
        Case 0
            FormatPhone = Null
        Case 7
            FormatPhone = Format(strIn, "@@@-@@@@")
        Case 10
            FormatPhone = Format(strIn, "(@@@) @@@-@@@@")
        Case 11
            FormatPhone = Format(strIn, "@ (@@@) @@@-@@@@")
        Case Else
            FormatPhone = strIn
    End Select
End Function

Both methods work. That said, the second one is much easier to keep adding to and probably run faster too since it does not call upon other procedures (Left(), Right(), Mid(), …) in it’s formatting process. Although with today’s computers you couldn’t tell the difference anyways.

MS Access VBA – Determine the First Day of the Week

Have you ever needed to determine the Sunday or Monday of a week. The following procedure will determine the date of the beginning of the week based on a given date within the week.

'---------------------------------------------------------------------------------------
' Procedure : GetFirstofWeek
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Determine the date of the first day of the week for a given date
' 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:
' ~~~~~~~~~~~~~~~~
' dtDate    : Date to find the start of the week of
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' GetFirstofWeek(#10/2/2009#)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2009-Nov-16                 Initial Release
'---------------------------------------------------------------------------------------
Function GetFirstofWeek(dtDate As Date)
On Error GoTo Error_Handler
    'GetFirstofWeek = DateAdd("d", dtDate, -(Weekday(dtDate)) + 1) 'Returns the Sunday
    GetFirstofWeek = DateAdd("d", dtDate, -(Weekday(dtDate)) + 2) 'Returns the Monday

Exit Function

Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: GetFirstofWeek" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occurred!"
    Exit Function
End Function

MS Access VBA – Generate a Random String

The following procedure can be used to generate a random string of specified length by the user.

Furthermore, the procedure allows the user to specify whether to include: numeric, uppercase and/or lowercase characters in the generated string. It requires no reference libraries and should work in any VBA application (MS Word, MS Excel, MS Access, …).

Thus, it is a great little function that can be used to generate random password, random string, etc.

'---------------------------------------------------------------------------------------
' Procedure : GenRandomStr
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Generate a random string (alpha, numeric or alphanumeric)
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' iNoChars      - No of characters the random string should be in length
' bNumeric      - Should the random string include Numeric characters
' bUpperAlpha   - Should the random string include Uppercase Alphabet characters
' bLowerAlpha   - Should the random string include Lowercase Alphabet characters
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' GenRandomStr(12, True, False, True)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2009-11-11              Initial Release
' 2         2018-06-11              Copyright update
'                                   Added missing variable declaration to make the
'                                       function Option Explicit compliant
'---------------------------------------------------------------------------------------
Function GenRandomStr(iNoChars As Integer, _
                      bNumeric As Boolean, _
                      bUpperAlpha As Boolean, _
                      bLowerAlpha As Boolean)
    On Error GoTo Error_Handler
    Dim AllowedChars()        As Variant
    Dim iNoAllowedChars       As Long
    Dim iEleCounter           As Long
    Dim i                     As Integer
    Dim iRndChar              As Integer

    'Initialize our array, otherwise it throws an error
    ReDim Preserve AllowedChars(0)
    AllowedChars(0) = ""

    'Build our list of acceptable characters to use to generate a string from
    'Numeric -> 48-57
    If bNumeric = True Then
        For i = 48 To 57
            iEleCounter = UBound(AllowedChars)
            ReDim Preserve AllowedChars(iEleCounter + 1)
            AllowedChars(iEleCounter + 1) = i
        Next i
    End If
    'Uppercase alphabet -> 65-90
    If bUpperAlpha = True Then
        For i = 65 To 90
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            iEleCounter = UBound(AllowedChars)
            AllowedChars(iEleCounter) = i
        Next i
    End If
    'Lowercase alphabet -> 97-122
    If bLowerAlpha = True Then
        For i = 97 To 122
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            iEleCounter = UBound(AllowedChars)
            AllowedChars(iEleCounter) = i
        Next i
    End If

    'Build the random string
    iNoAllowedChars = UBound(AllowedChars)
    For i = 1 To iNoChars
        Randomize
        iRndChar = Int((iNoAllowedChars * Rnd) + 1)
        GenRandomStr = GenRandomStr & Chr(AllowedChars(iRndChar))
    Next i

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GenRandomStr" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

MS Access VBA – Run or Execute a File

Have you ever needed to run a *.bat, *.vbs, *.exe, … file from within a database. It actually is quite simple using the Shell command. To simplify matters, and in response to a forum question, I created this simply function to do so. The beauty is that is will take care of adding the required quotes around long file name formats…

'---------------------------------------------------------------------------------------
' Procedure : RunFile
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Run/Execute files from vba (bat, vbs,…)
' 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 - full path including filename and extension
' strWndStyle - style of the window in which the program is to be run
'               value can be vbHide,vbNormalFocus,vbMinimizedFocus
'               vbMaximizedFocus,vbNormalNoFocus or vbMinimizedNoFocus
' Usage Example:
' ~~~~~~~~~~~~~~~~
' RunFile("c:\test.bat", vbNormalFocus)
' Revision History:
' ~~~~~~~~~~~~~~~~
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Feb-05             Initial Release
'---------------------------------------------------------------------------------------
Function RunFile(strFile As String, strWndStyle As String)
On Error GoTo Error_Handler

    Shell "cmd /k """ & strFile & """", strWndStyle

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: RunFile" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

MS Access – Calculate the Age

If you have ever needed to calculate the age between two dates, then the function below is for you. Often people mistakenly believe that the age calculation can simply be accomplished using the DateDiff() function, but this is not the case and a slightly more complex function is required to do the job.

To merely calculate the age of an individual in years, you can simply use the DateDiff().

=DateDiff("yyyy", [DOB], Date()) - IIF(Format([DOB], "mmdd") > Format(Date(), "mmdd"), 1, 0)

However, if you would like a little more detail (Years, Months, Days) you can use a function such as the one presented below.

Function fAge(dteStart As Variant, dteEnd As Variant) As Variant
'*******************************************
'Purpose:   Accurately return the difference
'           between two dates, expressed as
'           years.months.days
'Coded by:  raskew (from MS Access forum)
'Inputs:    From debug (immediate) window
'           1) ? fAge(#12/1/1950#, #8/31/2006#) 'Calculate btw 2 specific dates
'           2) ? fAge(#12/30/2005#, Date()) ' Calculate as of today's date
'*******************************************
Dim intHold   As Integer
Dim dayhold   As Integer

   'correctly return number of whole months difference
   'the (Day(dteEnd) < Day(dteStart)) is a Boolean statement
   'that returns -1 if true, 0 if false
   intHold = DateDiff("m", dteStart, dteEnd) + (Day(dteEnd) < Day(dteStart))

   'correctly return number of days difference
   If Day(dteEnd) < Day(dteStart) Then
      dayhold = DateDiff("d", dteStart, DateSerial(Year(dteStart), Month(dteStart) + 1, 0)) + Day(dteEnd)
   Else
      dayhold = Day(dteEnd) - Day(dteStart)
   End If

   fAge = LTrim(Str(intHold \ 12)) & " years " & LTrim(Str(intHold Mod 12)) & " months " & LTrim(Str(dayhold)) & " days"

End Function