如何使用拆分数据库在 MS Access 2010 应用程序中同步网络中的 6 台笔记本电脑
How to Sync 6 Laptops in network in MS Access 2010 Application with Split database
我在 MS Access 2010 中创建了一个应用程序构建,这创建了作业订单,我正在使用拆分数据库,它让我将表保存在服务器中,将前端程序保存在工作站中。现在,问题是我有 6 台笔记本电脑具有相同的应用程序,但是当外出时笔记本电脑断开网络连接。当笔记本电脑回到办公室并再次连接到网络时,我需要一种方法来同步表和已完成的工作。
我正在同步,按下一个按钮,将文件复制到服务器,在本地删除表格,然后从服务器复制回记录,但我想找到一种在笔记本电脑找到网络时自动同步的方法。
'*************IN THIS PART AM SENDING UPDATING SERVER AND SENDING NEW RECORDS ************
Dim x As Integer
Dim i As Integer
Dim strSQL As String
x = MsgBox("Are you Sure you want to Send to Server?????", vbOKCancel, "Are you sure?")
If x = vbOK Then
Dim intX, intY As Integer
Dim intW As Integer
Dim db As Database
Dim LSQL, SOurce, DestinaTion, fILE As String
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
SOurce = "O:\fieldticket\"
'DestinaTion = "\rvfile03\Departments\Water\Common\FieldTickets\"
DestinaTion = "\rwmain01\gis\FieldTicket\"
fILE = Dir$(SOurce & "*.one")
' Do While Len(fILE) > 0 And FSO.FileExists(DestinaTion & fILE) = True
Do While Len(fILE) > 0
If FSO.FileExists(fILE & DestinaTion) = False Then
FileCopy SOurce & fILE, DestinaTion & fILE
End If
fILE = Dir$()
Loop
fILE = Dir$(SOurce & "*.pdf")
Do While Len(fILE) > 0
If FSO.FileExists(fILE & DestinaTion) = False Then
FileCopy SOurce & fILE, DestinaTion & fILE
End If
fILE = Dir$()
Loop
Set db = CurrentDb()
' REINIT PROGRESS BAR
ProgressBarB.WIDTH = 0
Me.Repaint
' FILL IN OUR SQL QUERIES COLLECTION
Define_SQL_Queries
DoCmd.SetWarnings False
Me.Refresh
Me.Repaint
DoCmd.SetWarnings False
Me.Refresh
With CurrentDb
' ******* COUNT HOW MANY NEW RECORD ARE TRANSFERING **************************************************
intX = DCount("*", "RECORDS IN JobsOrder NOT IN JobsOrder1")
' ********** UPDATE JOBSORDER TABLE AND COUNT HOW MANY RECORDS ARE UPDATED ******************************
LSQL = "UPDATE_Jobsorder1_SERVER_WITH_Jobsorder"
db.Execute LSQL
' **************** GIVE A MESSAGE OF HOW MANY RECORDS ARE UPDATED AND TRANSFERED **********************
MsgBox CStr(db.RecordsAffected) & " RECORDS UPDATED " & intX & " NEW RECORDS WILL BE ADDED AND "
'************ new progress bar code using for command *************
Me.ProgressBarA.Visible = True
Me.ProgressBarB.Visible = True
For i = 1 To colSQL.Count
strSQL = colSQL(i)
Debug.Print "Executing : " & strSQL
Call .QueryDefs(strSQL).Execute
ProgressBarB.WIDTH = (ProgressBarA.WIDTH / colSQL.Count) * i
Me.Repaint
Next i
Call Me.Requery
DoCmd.SetWarnings True
End With
' MsgBox ("TRANSFER AND UPDATE HAS BEEN FINISHED!!!")
Me.ProgressBarA.Visible = False
Me.ProgressBarB.Visible = False
' Exit Sub
ElseIf x = vbCancel Then
Exit Sub
End If
'*******NOW I AM SENDING BACK FROM SERVER TO HANDHELD ************************
Dim y As Integer
Dim ii As Integer
Dim strSQL1, SOurce1, DestinaTion1, fIL1E As String
Beep
'x = MsgBox("Are you Sure you want to UPDATE HANDHELD?????", vbOKCancel, "Are you sure?")
'If y = vbOK Then
'If PASSWORD = "222222" Then
Dim intX1, intY1 As Integer
Dim intW1 As Integer
DoCmd.SetWarnings False
ProgressBarB.WIDTH = 0
Me.Repaint
'SOurce = "\rvfile03\Departments\Water\Common\FieldTickets\"
'DestinaTion = "c:\mapping\"
'fILE = Dir$(SOurce & "*.one")
'Do While Len(fILE) > 0
' If Dir$(fILE) & "" = "" Then
' FileCopy SOurce & fILE, DestinaTion & fILE
' End If
' fILE = Dir$()
'Loop
' FILL IN OUR SQL QUERIES COLLECTION
Define_SQL_Queries1
DoCmd.SetWarnings False
Me.Refresh
With CurrentDb
intX1 = DCount("*", "RECORD IN Jobsorder1 not Finished")
' MsgBox (intX1 & " RECORDS WILL BE ADDED")
Me.ProgressBarA.Visible = True
Me.ProgressBarB.Visible = True
For ii = 1 To colSQL1.Count
strSQL1 = colSQL1(ii)
Debug.Print "Executing : " & strSQL1
Call .QueryDefs(strSQL1).Execute
ProgressBarB.WIDTH = (ProgressBarA.WIDTH / colSQL1.Count) * ii
Me.Repaint
Next ii
Call Me.Requery
DoCmd.SetWarnings True
End With
MsgBox ("HANDHELD UPDATE COMPLETED!!!"), vbInformation
ProgressBarA.Visible = False
ProgressBarB.Visible = False
Exit Sub
'ElseIf y = vbCancel Then
' Exit Sub
'End If
MsgBox (intX1 & " RECORDS ADDED TO HANDHELD")
'******** FINISHING THE HANADHEL UPDATING *******************
您需要编写一些代码来检查连接(接下来连接到后端 table 时出错恢复并检查错误),然后连接到另一个本地 table如果离线。然后一旦回到办公室,该代码就可以正常连接,然后您可以上传您的工作。最重要的是,它需要一些 VBA 才能做到这一点。我无法在代码中为您提供解决方案,但这就是它的要点。
如果您知道如何在 VBA 中编码,那么您真的可以只检查网络文件夹,如果您在网络上,该文件夹就会存在。如果它不存在,那么您可以假设您处于离线状态。那么你将需要编写更多代码来处理本地 tables 而不是链接 tables.
Dim fso As FileSystemObject
Set fso = New FileSystemObject
If fso.FolderExists("[Path to Network Folder]") Then
' I'm online
Else
' I'm offline
End If
我在 MS Access 2010 中创建了一个应用程序构建,这创建了作业订单,我正在使用拆分数据库,它让我将表保存在服务器中,将前端程序保存在工作站中。现在,问题是我有 6 台笔记本电脑具有相同的应用程序,但是当外出时笔记本电脑断开网络连接。当笔记本电脑回到办公室并再次连接到网络时,我需要一种方法来同步表和已完成的工作。
我正在同步,按下一个按钮,将文件复制到服务器,在本地删除表格,然后从服务器复制回记录,但我想找到一种在笔记本电脑找到网络时自动同步的方法。
'*************IN THIS PART AM SENDING UPDATING SERVER AND SENDING NEW RECORDS ************
Dim x As Integer
Dim i As Integer
Dim strSQL As String
x = MsgBox("Are you Sure you want to Send to Server?????", vbOKCancel, "Are you sure?")
If x = vbOK Then
Dim intX, intY As Integer
Dim intW As Integer
Dim db As Database
Dim LSQL, SOurce, DestinaTion, fILE As String
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
SOurce = "O:\fieldticket\"
'DestinaTion = "\rvfile03\Departments\Water\Common\FieldTickets\"
DestinaTion = "\rwmain01\gis\FieldTicket\"
fILE = Dir$(SOurce & "*.one")
' Do While Len(fILE) > 0 And FSO.FileExists(DestinaTion & fILE) = True
Do While Len(fILE) > 0
If FSO.FileExists(fILE & DestinaTion) = False Then
FileCopy SOurce & fILE, DestinaTion & fILE
End If
fILE = Dir$()
Loop
fILE = Dir$(SOurce & "*.pdf")
Do While Len(fILE) > 0
If FSO.FileExists(fILE & DestinaTion) = False Then
FileCopy SOurce & fILE, DestinaTion & fILE
End If
fILE = Dir$()
Loop
Set db = CurrentDb()
' REINIT PROGRESS BAR
ProgressBarB.WIDTH = 0
Me.Repaint
' FILL IN OUR SQL QUERIES COLLECTION
Define_SQL_Queries
DoCmd.SetWarnings False
Me.Refresh
Me.Repaint
DoCmd.SetWarnings False
Me.Refresh
With CurrentDb
' ******* COUNT HOW MANY NEW RECORD ARE TRANSFERING **************************************************
intX = DCount("*", "RECORDS IN JobsOrder NOT IN JobsOrder1")
' ********** UPDATE JOBSORDER TABLE AND COUNT HOW MANY RECORDS ARE UPDATED ******************************
LSQL = "UPDATE_Jobsorder1_SERVER_WITH_Jobsorder"
db.Execute LSQL
' **************** GIVE A MESSAGE OF HOW MANY RECORDS ARE UPDATED AND TRANSFERED **********************
MsgBox CStr(db.RecordsAffected) & " RECORDS UPDATED " & intX & " NEW RECORDS WILL BE ADDED AND "
'************ new progress bar code using for command *************
Me.ProgressBarA.Visible = True
Me.ProgressBarB.Visible = True
For i = 1 To colSQL.Count
strSQL = colSQL(i)
Debug.Print "Executing : " & strSQL
Call .QueryDefs(strSQL).Execute
ProgressBarB.WIDTH = (ProgressBarA.WIDTH / colSQL.Count) * i
Me.Repaint
Next i
Call Me.Requery
DoCmd.SetWarnings True
End With
' MsgBox ("TRANSFER AND UPDATE HAS BEEN FINISHED!!!")
Me.ProgressBarA.Visible = False
Me.ProgressBarB.Visible = False
' Exit Sub
ElseIf x = vbCancel Then
Exit Sub
End If
'*******NOW I AM SENDING BACK FROM SERVER TO HANDHELD ************************
Dim y As Integer
Dim ii As Integer
Dim strSQL1, SOurce1, DestinaTion1, fIL1E As String
Beep
'x = MsgBox("Are you Sure you want to UPDATE HANDHELD?????", vbOKCancel, "Are you sure?")
'If y = vbOK Then
'If PASSWORD = "222222" Then
Dim intX1, intY1 As Integer
Dim intW1 As Integer
DoCmd.SetWarnings False
ProgressBarB.WIDTH = 0
Me.Repaint
'SOurce = "\rvfile03\Departments\Water\Common\FieldTickets\"
'DestinaTion = "c:\mapping\"
'fILE = Dir$(SOurce & "*.one")
'Do While Len(fILE) > 0
' If Dir$(fILE) & "" = "" Then
' FileCopy SOurce & fILE, DestinaTion & fILE
' End If
' fILE = Dir$()
'Loop
' FILL IN OUR SQL QUERIES COLLECTION
Define_SQL_Queries1
DoCmd.SetWarnings False
Me.Refresh
With CurrentDb
intX1 = DCount("*", "RECORD IN Jobsorder1 not Finished")
' MsgBox (intX1 & " RECORDS WILL BE ADDED")
Me.ProgressBarA.Visible = True
Me.ProgressBarB.Visible = True
For ii = 1 To colSQL1.Count
strSQL1 = colSQL1(ii)
Debug.Print "Executing : " & strSQL1
Call .QueryDefs(strSQL1).Execute
ProgressBarB.WIDTH = (ProgressBarA.WIDTH / colSQL1.Count) * ii
Me.Repaint
Next ii
Call Me.Requery
DoCmd.SetWarnings True
End With
MsgBox ("HANDHELD UPDATE COMPLETED!!!"), vbInformation
ProgressBarA.Visible = False
ProgressBarB.Visible = False
Exit Sub
'ElseIf y = vbCancel Then
' Exit Sub
'End If
MsgBox (intX1 & " RECORDS ADDED TO HANDHELD")
'******** FINISHING THE HANADHEL UPDATING *******************
您需要编写一些代码来检查连接(接下来连接到后端 table 时出错恢复并检查错误),然后连接到另一个本地 table如果离线。然后一旦回到办公室,该代码就可以正常连接,然后您可以上传您的工作。最重要的是,它需要一些 VBA 才能做到这一点。我无法在代码中为您提供解决方案,但这就是它的要点。
如果您知道如何在 VBA 中编码,那么您真的可以只检查网络文件夹,如果您在网络上,该文件夹就会存在。如果它不存在,那么您可以假设您处于离线状态。那么你将需要编写更多代码来处理本地 tables 而不是链接 tables.
Dim fso As FileSystemObject
Set fso = New FileSystemObject
If fso.FolderExists("[Path to Network Folder]") Then
' I'm online
Else
' I'm offline
End If