VBA Access Database Update For Developers – 64 bit

For a client I am currently doing work for, we have a mixture of Access versions. Both versions are Access 2016, but one version is 32 bit, and the other is 64 bit (Office 365 version).

Whenever a new version of the database is released, the users can click a button to upgrade the database they are using to the most recent version.

The .accdb file is pulled down from the server and is loaded on the user’s machine, without user or admin intervention.

That’s great, empower the users.

Here is the code that works great for the 32 bit users:

'*******************************************************
'IN A BASIC MODULE:
'*******************************************************
'this is an windows api call (put PtrSafe with 64 bit versions, this works with 32 bit)
Public Declare PtrSafe Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long


Public Type SHFILEOPSTRUCT
    hWnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Long
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As Long
End Type



Public Function VBCopyFolder(ByRef strSource As String, ByRef strTarget As String)
    Dim op As SHFILEOPSTRUCT
    Dim i As Long
    
    With op
        .wFunc = FO_COPY '(2 is the numerical value for FO_COPY)
        .pTo = strTarget
        .pFrom = strSource
        .fFlags = False
    End With

    '~~> Perform operation
    'success = 0
    'not successful = 87
    i = SHFileOperation(op)
End Function


Function FileOrDirExists(PathName As String) As Boolean
     'Purpose: Function returns TRUE if the specified file
     '               or folder exists, false if not.
     
    Dim intTemp As Integer
     
    'Ignore errors to allow for error evaluation
    On Error Resume Next
    
    intTemp = GetAttr(PathName)
     
    'Check if error exists and set response appropriately when it does
    Select Case Err.Number
      Case Is = 0
          FileOrDirExists = True
      Case Else
          FileOrDirExists = False
    End Select
     
     'Resume error checking
    On Error GoTo 0
End Function

'*******************************************************
'after clicking on form button:
'*******************************************************

Private Sub btnDBUpdate_Click()
    Dim strSourcePath As String
    Dim strDestPath As String

    'network drive
    strSourcePath = "R:\DatabaseFiles"

    'local drive
    strDestPath = "C:\DatabaseFolder"

    'delete old existing database
    If FileOrDirExists(strDestPath & "\Interface.accdb") Then
        'if the old existing database file exists, delete it
        Kill strDestPath & "\Interface.accdb"
    End If          

    'copy newly updated database
    Call VBCopyFolder(strSourcePath & "Interface.accdb", strDestPath & "\Interface.accdb")


    'copy all the contents of a folder
    Call VBCopyFolder(strSourcePath & "ImageFiles", strDestPath & "\ImageFiles")


    
End Sub

This code will show you the professional copying files image like this:

…of course it will be customized with your information.

but for 64 bit Access users …

…you will need to add some extra text to the “Long” datatypes.

THAT’S ALL YOU HAVE TO DO! (not real complex…just trying to find out the solution is a pain in the hind quarters )

Here’s the code (all the same, but change Long to LongPtr)

'*******************************************************
'IN A BASIC MODULE:
'*******************************************************
'this is an windows api call (put PtrSafe with 64 bit versions, this works with 32 bit)
Public Declare PtrSafe Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long


Public Type SHFILEOPSTRUCT
    hWnd As LongPtr
    wFunc As LongPtr
    pFrom As String
    pTo As String
    fFlags As LongPtr
    fAnyOperationsAborted As LongPtr
    hNameMappings As LongPtr
    lpszProgressTitle As LongPtr
End Type



Public Function VBCopyFolder(ByRef strSource As String, ByRef strTarget As String)
    Dim op As SHFILEOPSTRUCT
    Dim i As Long
    
    With op
        .wFunc = FO_COPY '(2 is the numerical value for FO_COPY)
        .pTo = strTarget
        .pFrom = strSource
        .fFlags = False
    End With

    '~~> Perform operation
    'success = 0
    'not successful = 87
    i = SHFileOperation(op)
End Function


Function FileOrDirExists(PathName As String) As Boolean
     'Purpose: Function returns TRUE if the specified file
     '               or folder exists, false if not.
     
    Dim intTemp As Integer
     
    'Ignore errors to allow for error evaluation
    On Error Resume Next
    
    intTemp = GetAttr(PathName)
     
    'Check if error exists and set response appropriately when it does
    Select Case Err.Number
      Case Is = 0
          FileOrDirExists = True
      Case Else
          FileOrDirExists = False
    End Select
     
     'Resume error checking
    On Error GoTo 0
End Function

'*******************************************************
'after clicking on form button:
'*******************************************************

Private Sub btnDBUpdate_Click()
    Dim strSourcePath As String
    Dim strDestPath As String

    'network drive
    strSourcePath = "R:\DatabaseFiles"

    'local drive
    strDestPath = "C:\DatabaseFolder"

    'delete old existing database
    If FileOrDirExists(strDestPath & "\Interface.accdb") Then
        'if the old existing database file exists, delete it
        Kill strDestPath & "\Interface.accdb"
    End If          

    'copy newly updated database
    Call VBCopyFolder(strSourcePath & "Interface.accdb", strDestPath & "\Interface.accdb")


    'copy all the contents of a folder
    Call VBCopyFolder(strSourcePath & "ImageFiles", strDestPath & "\ImageFiles")


    
End Sub

Hope it works for you, and let me know if you have any questions.

By the way, if you got or are getting value from the VBA information, please give me a tip, thanks!