|
@@ -0,0 +1,90 @@
|
|
|
|
|
+Option Compare Database
|
|
|
|
|
+Public Const ADDIN_NAME = "OpenAccess.accda"
|
|
|
|
|
+
|
|
|
|
|
+Sub test()
|
|
|
|
|
+ Dim dbpath As String
|
|
|
|
|
+ Dim db As DAO.Database
|
|
|
|
|
+ Dim td As DAO.TableDef
|
|
|
|
|
+ dbpath = CurrentProject.path
|
|
|
|
|
+
|
|
|
|
|
+ Set db = CurrentDb
|
|
|
|
|
+ Set td = db.TableDefs("linked_table")
|
|
|
|
|
+ td.Connect = ";DATABASE=" & dbpath & "\db.accdb"
|
|
|
|
|
+ td.RefreshLink
|
|
|
|
|
+
|
|
|
|
|
+End Sub
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+Private Sub setUp_tests()
|
|
|
|
|
+
|
|
|
|
|
+ ' update linked table
|
|
|
|
|
+ Dim dbpath As String
|
|
|
|
|
+ Dim db As DAO.Database
|
|
|
|
|
+ Dim td As DAO.TableDef
|
|
|
|
|
+ dbpath = CurrentProject.path
|
|
|
|
|
+
|
|
|
|
|
+ Set db = CurrentDb
|
|
|
|
|
+ Set td = db.TableDefs("linked_table")
|
|
|
|
|
+ td.Connect = ";DATABASE=" & dbpath & "\db.accdb"
|
|
|
|
|
+ td.RefreshLink
|
|
|
|
|
+
|
|
|
|
|
+ ' import reference OpenAccess.accda
|
|
|
|
|
+ Dim tmp_path, oa_path As String
|
|
|
|
|
+ tmp_path = CurrentProject.path
|
|
|
|
|
+ oa_path = tmp_path & "\" & ADDIN_NAME
|
|
|
|
|
+
|
|
|
|
|
+ Do Until Dir(oa_path) <> ""
|
|
|
|
|
+ If Len(tmp_path) = 0 Then
|
|
|
|
|
+ Debug.Print "setUp_tests - Unable to find " & ADDIN_NAME & " in the parents directory"
|
|
|
|
|
+ Exit Sub
|
|
|
|
|
+ End If
|
|
|
|
|
+
|
|
|
|
|
+ tmp_path = parDir(tmp_path)
|
|
|
|
|
+ oa_path = tmp_path & "\" & ADDIN_NAME
|
|
|
|
|
+
|
|
|
|
|
+ Loop
|
|
|
|
|
+
|
|
|
|
|
+ On Error Resume Next
|
|
|
|
|
+ Access.References.AddFromFile (oa_path)
|
|
|
|
|
+
|
|
|
|
|
+ DoEvents
|
|
|
|
|
+
|
|
|
|
|
+ If Err.Number = 32813 Then
|
|
|
|
|
+ 'already added
|
|
|
|
|
+ Else
|
|
|
|
|
+ Debug.Print "setUp_tests - Error while loading " & ADDIN_NAME & " as a reference"
|
|
|
|
|
+ End If
|
|
|
|
|
+
|
|
|
|
|
+End Sub
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+Public Function test_export()
|
|
|
|
|
+ 'run an OpenAccess export on itself
|
|
|
|
|
+ setUp_tests
|
|
|
|
|
+
|
|
|
|
|
+ Dim result As Integer
|
|
|
|
|
+ result = Application.Run("silent_export")
|
|
|
|
|
+
|
|
|
|
|
+ Err.Number = result
|
|
|
|
|
+ Application.Quit
|
|
|
|
|
+
|
|
|
|
|
+End Function
|
|
|
|
|
+
|
|
|
|
|
+Public Function test_import()
|
|
|
|
|
+ 'run an OpenAccess import on itself
|
|
|
|
|
+ setUp_tests
|
|
|
|
|
+
|
|
|
|
|
+ Dim result As Integer
|
|
|
|
|
+ result = Application.Run("silent_import")
|
|
|
|
|
+
|
|
|
|
|
+ Err.Number = result
|
|
|
|
|
+ Application.Quit
|
|
|
|
|
+
|
|
|
|
|
+End Function
|
|
|
|
|
+
|
|
|
|
|
+Private Function parDir(ByVal path As String) As String
|
|
|
|
|
+
|
|
|
|
|
+ parDir = CreateObject("Scripting.FileSystemObject").GetParentFolderName(path)
|
|
|
|
|
+
|
|
|
|
|
+End Function
|