Friday, November 5, 2021

How to check if an Access database object exist

The Usual Approach

The idea for this function came to me while responding to a question in the forums on how to check if a query exist. The usual approach is to assign the query's name to a QueryDef object and trap the error, if the query does not exist. For example:

Public Function QueryExists(QueryName As String) As Boolean 'thedbguy@gmail.com '11/5/2021

Dim qdf As DAO.QueryDef

On Error Resume Next

Set qdf = CurrentDb.QueryDefs(QueryName)

If Err = 0 Then     QueryExists = True Else     QueryExists = False End If

Set qdf = Nothing

End Function


A Better Approach

Now, the above approach of using On Error Resume Next and then checking for errors is a very common approach. However, someone in the forums mentioned that this is not a very "clean" approach, because it leaves an Error Object hanging in the Errors Collection. They mentioned that their preferred method is to loop through the QueryDefs collection and check for the name of the query. For instance:
Public Function QueryExists_1(QueryName As String) As Boolean
'thedbguy@gmail.com
'11/5/2021

Dim qdf As DAO.QueryDef
Dim blnReturn As Boolean

For Each qdf In CurrentDb.QueryDefs
    If qdf.Name = QueryName Then
        blnReturn = True
        Exit For
    End If
Next

QueryExists_1 = blnReturn

End Function


An Even Better Approach

Now, that makes a lot of sense, doesn't it. However, another smart person said: "Why not just use the MSysObjects table to check if the query exist?" Well, isn't that genius. So, inspired by that comment, I decided to create the following function as another option for checking if an Access database object exist or not. It goes something like this:
Option Compare Database
Option Explicit

Public Enum dbgObjectType
    dbgTable = 1
    dbgQuery = 5
    dbgForm = -32768
    dbgReport = -32764
    dbgMacro = -32766
    dbgModule = -32761
    dbgODBCLinkedTable = 4
    dbgOtherLinkedTable = 6
    
End Enum

Public Function ObjectExists(ObjectName As String, ObjectType As dbgObjectType, _ Optional DatabasePath As String) As Boolean
'thedbguy@gmail.com
'11/5/2021

Dim blnReturn As Boolean

If DatabasePath = "" Then
blnReturn = DCount("*", "MSysObjects", "[Name]='" _ & ObjectName & "' AND [Type]=" & ObjectType)
    
ElseIf Dir(DatabasePath) = "" Then
    'MsgBox "Cannot find " & DatabasePath, vbInformation, "Info!"
    Debug.Print "Cannot find " & DatabasePath
    blnReturn = False
    
Else
    blnReturn = CurrentDb.OpenRecordset("SELECT Count(*) FROM [;Database=" _
        & DatabasePath & "].MSysObjects WHERE [Name]='" _
        & ObjectName & "' AND [Type]=" & ObjectType)(0)
    
End If

ObjectExists = blnReturn

End Function
As you can see, I have decided to use an enumeration and allow the user to specify which object they want to search. Also, the above function allows the user to search objects in an external database. I just thought these additional features might help make the function a lot more flexible and allow the developer to use it in multiple situations. So, now, the above approach does not rely on the Error object and also skips going through a loop to search for a single object.


Extension

Having the above function available, we can even extend the idea by creating smaller helper functions designed to search for a specific object. Here are some examples:

Public Function TableExists(TableName As String, Optional DatabasePath As String) As Boolean

TableExists = ObjectExists(TableName, dbgTable, DatabasePath)

End Function


Public Function FormExists(FormName As String, Optional DatabasePath As String) As Boolean

FormExists = ObjectExists(FormName, dbgForm, DatabasePath)

End Function

I hope the above information was useful, and I welcome any comments, recommendations, or criticisms.

As always, thanks for reading. Cheers!

Friday, October 1, 2021

How to get the Filename from a FilePath

I'm sure we all have helper functions. Those are the little functions we tend to use inside larger sections of code to simply return a specific piece of information for further processing. They are typically short with only a few lines of code in them.

As I was assisting a forum member today, I had to provide a way to extract the file's name from a given file path, so they can copy it to another folder location and rename the file at the same time. Just in case it may help others as well, the following code snippets are some of the several ways to accomplish that task.

This first one simply uses the InStrRev() function to locate the last backslash (\) in the file path to return the file's name.

Public Function iGetFilename(FilePath As String) As String
'thedbguy@gmail.com
'10/1/2021

iGetFilename = Mid(FilePath, InStrRev(FilePath, "\") + 1)

End Function

This next one uses the Split() function to divide the entire file path using the backslash as the slicer and then returns the last item in the array.

Public Function sGetFilename(FilePath As String) As String
'thedbguy@gmail.com
'10/1/2021

Dim strArr() As String

strArr() = Split(FilePath, "\")

sGetFilename = strArr(UBound(strArr))

End Function

I also got to thinking that we might be able to use a RegEx pattern to extract the file's name from the file path, and that's really the reason why I decided to post this blog today. I can't say the pattern I came up with is the best one to use. So, if anyone has a better one, please share it.

Public Function rGetFilename(FilePath As String) As String
'thedbguy@gmail.com
'10/1/2021

Dim regEx As Object
Dim regExMatch As Object

Set regEx = CreateObject("VBScript.RegExp")

With regEx
    .IgnoreCase = True
    .Pattern = "[^\\]+\.[a-z]{2,5}$"
    Set regExMatch = .Execute(FilePath)
End With

If regExMatch.Count > 0 Then
    rGetFilename = regExMatch(0).Value
End If

End Function

Additionally, I also found out another way of getting the file name using the FileSystemObject library. It turns out the FSO has many methods available for working with files. Here's an example.

Public Function fGetFilename(FilePath As String) As String
'thedbguy@gmail.com
'10/1/2021

Dim fso As Object

Set fso = CreateObject("Scripting.FileSystemObject")

fGetFilename = fso.GetFilename(FilePath)

Set fso = Nothing

End Function

As always, thank you for reading this and please let me know if you have any comments regarding this topic or any of the code I presented above. Cheers!

Wednesday, August 25, 2021

SimpleCSV() v2.0

 A few years ago, I wrote a simple function called SimpleCSV() to concatenate records and posted it on my website. One main drawback of this function is it doesn't work with parameter queries.

I have always pointed people to Leigh's Generic Recordset function to deal with parameter queries and avoid the "3061. Too few parameters" error.

Today, I was trying to help someone in the forum and decided to combine the two functions together. The following updated version of the SimpleCSV() function should be able to handle certain parameter queries. Please let me know if you find any bug.

Public Function SimpleCSV(strSQL As String, _
            Optional strDelim As String = ",") As String
'Returns a comma delimited string of all the records in the SELECT SQL statement
'Source: http://www.accessmvp.com/thedbguy
'v1.0 - 8/20/2013
'v2.0 - 8/25/2021 Handles parameter queries

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim prm As Variant
Dim strCSV As String

Set db = CurrentDb()

Set qdf = db.CreateQueryDef("", "SELECT * FROM (" & strSQL & ")")

With qdf
    For Each prm In qdf.Parameters
        prm.Value = Eval(prm.Name)
    Next
End With

Set rs = qdf.OpenRecordset

'Concatenate the first (and should be the only one) field from the SQL statement
With rs
    Do While Not .EOF
        strCSV = strCSV & strDelim & .Fields(0)
        .MoveNext
    Loop
    .Close
End With

'Remove the leading delimiter and return the result
SimpleCSV = Mid$(strCSV, Len(strDelim) + 1)

Set rs = Nothing
Set qdf = Nothing
Set db = Nothing

End Function


Friday, March 5, 2021

Download a File from the Internet

 To download a file from the Internet, one option is to use the URLDownloadToFile API, which looks something like this.

#If VBA7 Then
  Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                                (ByVal pCaller As Long, _
                                 ByVal szURL As String, _
                                 ByVal szFileName As String, _
                                 ByVal dwReserved As Long, _
                                 ByVal lpfnCB As Long) As Long
#Else
  Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                        (ByVal pCaller As Long, _
                         ByVal szURL As String, _
                         ByVal szFileName As String, _
                         ByVal dwReserved As Long, _
                         ByVal lpfnCB As Long) As Long
#End If

You could then use the above in a function like this.

lngResult = URLDownloadFile(0,URL,Filename,0,0) 

However, if you're like me and don't want to use API calls, you can also achieve the above goal by using a HTTPRequest class. 

Here's an example VBA subroutine to download a file from the Internet.

Public Sub DownloadFile(URL As String)
'thedbguy@gmail.com
'3/5/2021
'used to download a file from the Internet
'assumes filename is at the end of the URL
'file is saved in the current project folder
'usage: DownloadFile "http://www.accessmvp.com/thedbguy/img/shrek.jpg"

Dim objHTTP As Object
Dim FileByte() As Byte
Dim strFile As String
Dim intFile As Integer

intFile = FreeFile()
strFile = Mid(URL, InStrRev(URL, "/") + 1)

Set objHTTP = CreateObject("Microsoft.XMLHTTP")

With objHTTP
    .Open "GET", URL, False
    .Send
    If .Status = 200 Then
        FileByte = .responseBody
    End If
End With

Open CurrentProject.Path & "\" & strFile For Binary Lock Read Write As #intFile
    Put #intFile, , FileByte
Close #intFile

Set objHTTP = Nothing

End Sub

The above code does not include any error handlers, so you will have to add that part yourself. Also, the above code was not fully tested on all possible file types. It worked well for me when downloading image and PDF files though. Please let me know if you find a file type that this code was not able to handle.

As usual, thank you for reading and please let me know if you find this information useful.

Good luck with your project.


Friday, July 3, 2020

Get User's Full Name

I received an email from someone requesting assistance in Access on how to retrieve the user's full name from the system, not their username. I was told that Excel has the method Application.UserName available to do this.Not being familiar with Excel, I wasn't aware of that method.

Unfortunately, that method is not available in Access. However, I knew you can run some Excel methods from Access. For example, the following code should do the job.

Public Function GetUserXLFullName() As String
'thedbguy@gmail.com
'7/3/2020

Dim xlApp As Object

Set xlApp = CreateObject("Excel.Application")

GetUserXLFullName = xlApp.Application.UserName

Set xlApp = Nothing

End Function

But on the other hand, I also know I have used code to query the Active Directory before. As an example, here is a link to a function on my website on how to get the user's email address from Active Directory.

So, based on that example, a simple modification is all we need to get the user's Full Name from Active Directory. For instance:

Public Function GetUserADFullName() As String
'thedbguy@gmail.com
'7/3/2020

Dim objADInfo As Object
Dim objADUser As Object

Set objADInfo = CreateObject("ADSystemInfo")
Set objADUser = GetObject("LDAP://" & objADInfo.UserName)

GetUserADFullName = objADUser.FullName

Set objADUser = Nothing
Set objADInfo = Nothing

End Function

While testing these two approaches, I discovered using the Active Directory method to be faster than using Excel. Please let me know if your experience is the same. Also, please tell us if you know another method of retrieving the user's full name from the system. Thank you for reading. Cheers!