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.