Windows XP 
Access 2007
So i have this code from a co-worker that i need help with. First i will start by telling you a little about the DB. It is a Inventory DB. I have it split with a BE and FE residing on a network share and copy of the FE stored on the users My Documents. There is smaller Database called Update. The Update data base is just a reference Database so when the end user opens the local version in there my documents folder it checks the update database table for a version number. If it sees its different the local FE it will copy the newest version to users my documents.
My problem is when it goes to re open the new database i only opens Access.exe and not the updated version newly copied into the my documents.
This is the code i have setup on main form of the update database.
-----------
Option Compare Database
Option Explicit
Dim strPath As String
Dim strDest As String
Dim strBkup As String
Dim strMyDB As String
Dim strVer As String
Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
'If ReconnectTables = True Then
DoEvents
'Version Check
strVer = DLookup("[Version]", "tblVersionServer")
'Load variables with correct file name-path values.
strMyDB = CurrentDb.Name
strPath = Left(strMyDB, LastInStr(strMyDB, "\"))
strDest = Replace(strPath, "\\Mppfs02\Workgroups\MPP IS\Database\", "IS Inventory_fe.accdb") 'MATCH NETWORK LOCATION OF FRONTEND
strBkup = Replace(strPath, Environ$("USERPROFILE") & "\\" & "My Documents\", "BU-2013-06-11_6-4-13hardwareasset_fe.accdb") 'CHANGE BU_xxx to BU_NAME OF FRONTEND
'Stop processing to view auto-running code
'Stop
' Kill any existing backup, create a new backup
If Dir(strBkup) <> "" Then Kill strBkup
FileCopy strDest, strBkup
If Dir(strDest) <> "" Then Kill strDest
'Else
' MsgBox "Couldn't Find Data Tables. Exiting.", vbCritical, "Error"
'End If
End Sub
Private Sub Form_Timer()
On Error Resume Next
Dim strSource As String
Dim strMsg As String
Dim strOpenClient As String
Const q As String = """"
Dim MyDocsPath As String
MyDocsPath = Environ$("USERPROFILE") & "\\" & "My Documents\IS Inventory_fe.accdb" 'CHANGE ASAP_xxx TO FRONT END NAME
DoCmd.Hourglass True
DoEvents
Err.Clear
' Copy newest version to User's MY DOCUMENTS
strSource = strPath & "IS Inventory_fe.accdb" 'CHANGE ASAP_xxx TO FRONT END NAME
FileCopy strSource, MyDocsPath
DoEvents
' Re-Open New Database for user
strOpenClient = "MSAccess.exe " & q & strDest & q
Shell strOpenClient, vbNormalFocus
' Close Update Database
DoCmd.Hourglass False
DoCmd.Quit
End Sub
Private Function ReconnectTables() As Boolean
On Error Resume Next
Dim tdf As DAO.TableDef
Dim dbs As DAO.Database
Dim strPath As String
Dim strConnect As String
Set dbs = CurrentDb
strPath = dbs.Name
strPath = Left(strPath, LastInStr(strPath, "\"))
strConnect = strPath & "IS Inventory_be.accdb" 'CHANGE ASAP_xxx TO BACK_END NAME
For Each tdf In dbs.TableDefs
If tdf.Connect <> "" Then
tdf.Connect = ";DATABASE=" & "\\mppfs02\Workgroups\MPP IS\DATABASE\" 'CHANGE LOCATION TO MATCH BACK_END
tdf.RefreshLink
End If
Next
Set dbs = Nothing
If Err.Number = 0 Then ReconnectTables = True
End Function
Public Function LastInStr(strSearched As String, strSought As String) As Integer
On Error Resume Next
Dim intCurrVal As Integer
Dim intLastPosition As Integer
intCurrVal = InStr(strSearched, strSought)
Do Until intCurrVal = 0
intLastPosition = intCurrVal
intCurrVal = InStr(intLastPosition + 1, strSearched, strSought)
Loop
LastInStr = intLastPosition
Reply With Quote
Originally Posted by RuralGuy
