Access database short-cut script 1

[dmaranan]

I currently have an access file (a front end to a SQL server database) on a server that I want 20 users to copy the file over to their machine, and then use their local copy.

However, everytime they open the local file I want a script to run that checks the database properties of the local access file and compare it to the properties on the server, and then if the file on the server is more up to date, I want the user to have the option of replacing the local copy.

Does anyone know how I can do this?

Thanks!

 

[GKProgrammer]

Hi dmaranan,

1) First thing you have to do is create a macro called autoexec and make it runcode from a module that will transfer from server to local

2) The following code should do what you require, note that I have not included transfering of tables and queries as those should all be located in your backend and therefore will not be transfered.

**********************CODE BEGIN***************

Function main()

Dim DateModifiedServer As String, DateModifiedCurrent As String
Dim currentdbName As String, serverdbname As String, placeholder As Byte
Dim dbs As DAO.Database
Dim doc As Document
Dim con As Container
Dim rel As Relation
Dim a(1 To 5)
Dim z As Long

On Error GoTo errhandler

a(1) = "Tables"
a(2) = "Forms"
a(3) = "Reports"
a(4) = "Scripts"
a(5) = "Modules"

serverdbname = &quot;C:\Set To Path of file on server&quot; '<-------SET PATH
currentdbName = CurrentDb.Name
DateModifiedCurrent = FileDateTime(currentdbName) 'find timestamp
DateModifiedServer = FileDateTime(serverdbname)
Set dbs = CurrentDb
If DateDiff(&quot;n&quot;, DateModifiedServer, DateModifiedCurrent) < 0 Then 'do if server file has been updated
With dbs
'For Each rel In .Relations 'delete relations of tables, not used for you purposes
' .Relations.Delete (rel.Name)
'Next rel
placeholder = 1
For z = 2 To 5 'loop through delete all reports, macros, forms and modules
With dbs.Containers(a(z))
'Debug.Print &quot;Documents in &quot; & .Name & &quot; container&quot;
For Each doc In .Documents
'won't delete autoexec, and module you are running code from
'***I called the module you will put this code in 'modupdate', if you want to change the name you will have to update in two places in this code***
If doc.Name <> &quot;autoexec&quot; And doc.Name <> &quot;modupdate&quot; And left$(doc.Name, 4) <> &quot;Msys&quot; Then
Select Case z
Case 1 'will not be executed because will not delete tables or queries
DoCmd.DeleteObject acTable, doc.Name
Case 2
DoCmd.DeleteObject acForm, doc.Name
Case 3
DoCmd.DeleteObject acReport, doc.Name
Case 4
DoCmd.DeleteObject acMacro, doc.Name
Case 5
DoCmd.DeleteObject acModule, doc.Name
End Select

End If
Next doc
End With
Next z
End With
Set dbs = OpenDatabase(serverdbname)

For z = 2 To 5 'copy all reports, macros, forms and modules from server db
With dbs.Containers(a(z))
'Debug.Print &quot;Documents in &quot; & .Name & &quot; container&quot;
For Each doc In .Documents
placeholder = 2
If doc.Name <> &quot;autoexec&quot; And doc.Name <> &quot;modupdate&quot; And left$(doc.Name, 4) <> &quot;Msys&quot; Then
Select Case z
Case 1 'will not be executed because will not import tables or queries
DoCmd.TransferDatabase acImport, &quot;Microsoft Access&quot;, serverdbname, acQuery, doc.Name, doc.Name
If placeholder = 3 Then
DoCmd.TransferDatabase acImport, &quot;Microsoft Access&quot;, serverdbname, acTable, doc.Name, doc.Name
End If
Case 2
DoCmd.TransferDatabase acImport, &quot;Microsoft Access&quot;, serverdbname, acForm, doc.Name, doc.Name
Case 3
DoCmd.TransferDatabase acImport, &quot;Microsoft Access&quot;, serverdbname, acReport, doc.Name, doc.Name
Case 4
DoCmd.TransferDatabase acImport, &quot;Microsoft Access&quot;, serverdbname, acMacro, doc.Name, doc.Name
Case 5
DoCmd.TransferDatabase acImport, &quot;Microsoft Access&quot;, serverdbname, acModule, doc.Name, doc.Name
End Select

End If
Next doc
End With
Next z
End If
dbs.Close
Exit Function
errhandler:
If Err.Number = 3011 Then
If placeholder = 1 Then
DoCmd.DeleteObject acQuery, doc.Name
Else
placeholder = 3
End If
Resume Next
Else
MsgBox Err.Number & Err.Description
End If
dbs.Close

End Function


**********************CODE END***************


Let me know if this helps

Regards,
gkprogrammer