Retrieve Local IP Addresses

I received a question today if I knew how to retrieve the local machine's IP address, so they can use it for an audit trail log. I didn't have a ready-made solution, so I had to search for one. Luckily, I found VBA - Determine Your PC's IP Address created by Daniel Pineault at DevHut. I was very happy to pass this info along to the person who asked me the question as I am sure it would really help them in their project.

Later on, I began to wonder, just for fun, how I might modify Daniel's code to use regular expressions. I am not saying using regular expressions would make it better. I was just curious to see how differently it would look like. The below function is what I came up with after a quick search for a good regex pattern.

I am not trying to create a replacement function, so I merely concentrated on grabbing the IPv4 addresses and did not include any error checks in the code. If you decide to use this, please test it thoroughly and let me know how it can be improved. Thank you!

Public Function GetMyIPs() As String
'thedbguy@gmail.com
'5/19/2025
'https://www.devhut.net/vba-determine-your-pcs-ip-address/
'https://ihateregex.io/expr/ip/

Dim regEx As Object
Dim regExMatch As Object
Dim var As Variant
Dim strIPInfo As String
Dim strResult As String

'use ipconfig to get IP info
CreateObject("Wscript.Shell").Run "cmd /c ipconfig | findstr /R /C:""IPv4 Address"" | clip", 0, True
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") 'use clipboard
    .GetFromClipboard
    strIPInfo = .GetText
End With

'parse IP info
Set regEx = CreateObject("VBScript.RegExp")
With regEx
    .Global = True
    .IgnoreCase = True
    .Pattern = "(\b25[0-5]|\b2[0-4][0-9]|\b[01]?[0-9][0-9]?)(\.(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)){3}"
    Set regExMatch = .Execute(strIPInfo)
    For Each var In regExMatch
        strResult = strResult & ";" & var
    Next
    
End With

If strResult <> "" Then
    GetMyIPs = Mid(strResult, 2)
End If

Set regExMatch = Nothing
Set regEx = Nothing

End Function

SHA256 Hashing Function

I know this is not a new topic, but I just thought I would post it here for my own future reference.

I have used other SHA256 hashing functions before, but they were long and complicated with multiple loops.

I discovered that the same thing can be accomplished by taking advantage of some built-in .Net Framework methods.

The below function should work in Access VBA without any need for additional or external references.

Please let me know if you run into any issues or if you have any suggestions for improvements.

Happy New Year!

Function dbgSHA256(PlainText As String) As String
'thedbguy@gmail.com
'1/1/2025

Dim encoder As Object
Dim hasher As Object
Dim textToHash() As Byte
Dim hash() As Byte
Dim cypher() As String
Dim x As Long

' Create objects for encoding and hashing
Set encoder = CreateObject("System.Text.UTF8Encoding")
Set hasher = CreateObject("System.Security.Cryptography.SHA256Managed")

' Convert the input string to bytes
textToHash = encoder.GetBytes_4(PlainText)

' Compute the hash
hash = hasher.ComputeHash_2(textToHash)

' Convert the hash to a hexadecimal string
ReDim cypher(UBound(hash))
For x = 0 To UBound(hash)
    cypher(x) = Hex$(hash(x))
Next

' Return the result
dbgSHA256 = Join(cypher, "")

' Clean up objects
Set hasher = Nothing
Set encoder = Nothing

End Function

Retrieve Active Directory Group Membership Info

Hello, everyone! It's been a while since I wrote something here. I hope I can get back into it.

I was helping someone in the forum recently regarding how to check if a user was a member of a certain active directory (AD) group. They wanted to use this information to add some security features to their Access application. In the process of helping them, I ended up creating two functions. The first one is used to create a list of all the AD groups for a given user. The second one is used to verify if a given user is a member of a specified network group. (The forum poster really only needed the second function, but I had to create the first one, so I can properly check the second function.)

ListUserGroups()

As already mentioned, this function will iterate through the group membership for a given username. If the username is not provided, the function will list the group membership for the current user. The sample function below simply outputs the group listing in the Immediate Window. It is up to you to modify the function to store or display the information as required in your project.

Public Function ListUserGroups(Optional User As String) As Boolean
'thedbguy@gmail.com
'12/13/2023

Dim objUser As Object
Dim objGroup As Object
Dim strDomain As String

With CreateObject("WScript.Network")
    strDomain = .UserDomain
    If User = "" Then User = .UserName

End With

Set objUser = GetObject("WinNT://" & strDomain & "/" & User & ",user")

For Each objGroup In objUser.Groups
    Debug.Print objGroup.Name

Next

Set objGroup = Nothing
Set objUser = Nothing

End Function

IsGroupMember()

In contrast, the following function will simply return True or False to verify if the user is a member of a given network group. As I said earlier, I had to create the first function, because I needed to know the correct group name that I can use to check and verify if I was a member of it or not.

Public Function IsGroupMember(GroupName As String, Optional User As String) As Boolean
'thedbguy@gmail.com
'12/13/2023

Dim objGroup As Object
Dim strDomain As String
Dim strDomainUser As String

With CreateObject("WScript.Network")
    strDomain = .UserDomain
    If User = "" Then User = .UserName

End With

strDomain = "WinNT://" & strDomain & "/"

Set objGroup = GetObject(strDomain & GroupName & ",group")

IsGroupMember = objGroup.IsMember(strDomain & User)

Set objGroup = Nothing

End Function

Please note, the above functions do not contain any error handlers. I recommend that you consider adding them when you implement the above functions in your database.

I hope these functions would also come handy in your own Access application projects.

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 exists?" 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!

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!