Help with code..

[mgillespie21234]

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

 

[SOS]

Have you thought about using this existing tool that can enable auto updating quite quickly and easily and you wouldn't have to write anything?

http://www.btabdevelopment.com/ts/freetools

 

[Solo712]

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

Hi,
the Shell command is not an SQL command and therefore the extra quotes (q) are redundant. Just give it the fully formed path.

'Re-Open New Database for user
strOpenClient = "MSAccess.exe " & strDest, vbNormalFocus 
Shell strOpenClient, vbNormalFocus

Nice routine, btw.

Best,
Jiri