home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / patchfix / dbpatch / patchdb.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-16  |  19.8 KB  |  554 lines
  1. Option Explicit
  2.  
  3. Global PatchDB As Database, InputDB As Database
  4. Global PatchDBName As String, InputDBName As String
  5. Global PatchTable As Table, InputTable As Table
  6. Global PatchDBOpen As Integer, InputDBOpen As Integer
  7. Global PatchFields(0) As Field, InputFields(0) As Field
  8. Global MSAccessPath As String, ProceedChoice As Integer
  9.  
  10. Global Const TABLE_OBJ = 0
  11. Global Const QUERY_OBJ = 1
  12. Global Const FORM_OBJ = 2
  13. Global Const REPORT_OBJ = 3
  14. Global Const MACRO_OBJ = 4
  15. Global Const MODULE_OBJ = 5
  16.  
  17. Sub CloseInputDB ()
  18.    On Error Resume Next
  19.    'InputTable.Close
  20.    'InputDB.Close
  21.    MainForm.InputLink.LinkMode = LM_NONE
  22.    InputDBOpen = False
  23.    InputDBName = ""
  24.    On Error GoTo 0
  25. End Sub
  26.  
  27. Sub ClosePatchDB ()
  28.    On Error Resume Next
  29.    'PatchTable.Close
  30.    'PatchDB.Close
  31.    MainForm.PatchLink.LinkMode = LM_NONE
  32.    PatchDBOpen = False
  33.    PatchDBName = ""
  34.    On Error GoTo 0
  35. End Sub
  36.  
  37. Sub DBClose ()
  38.    ClosePatchDB
  39.    CloseInputDB
  40. End Sub
  41.  
  42. Sub GetList (DBName As String, lnkCtrl As TextBox, lstCtrl As ListBox, lstType As String)
  43.    Dim StartPos As Integer, Pos As Integer
  44.    lnkCtrl.LinkMode = LM_NONE
  45.    lnkCtrl.LinkTopic = "MSAccess|" + DBName
  46.    lnkCtrl.LinkItem = lstType
  47.    lnkCtrl.LinkMode = LM_MANUAL
  48.    lnkCtrl.LinkRequest
  49.    lnkCtrl.LinkMode = LM_NONE
  50.    StartPos = 1
  51.    Do
  52.       Pos = InStr(StartPos, lnkCtrl.Text, Chr$(9))
  53.       If Pos = 0 Then
  54.      If StartPos < Len(lnkCtrl.Text) Then
  55.         Pos = Len(lnkCtrl.Text) + 1
  56.      Else
  57.         Exit Do
  58.      End If
  59.       End If
  60.       lstCtrl.AddItem Mid$(lnkCtrl.Text, StartPos, Pos - StartPos)
  61.       StartPos = Pos + 1
  62.    Loop
  63. End Sub
  64.  
  65. Function InList (ListCtrl As ListBox, TestStr As String) As Integer
  66.    Dim I As Integer
  67.    InList = False
  68.    For I = 0 To (ListCtrl.ListCount - 1) Step 1
  69.       If ListCtrl.List(I) = TestStr Then
  70.      InList = True
  71.      Exit For
  72.       End If
  73.    Next I
  74. End Function
  75.  
  76. Sub LocateMSAccess ()
  77.    Dim ErrSave As Integer
  78.    Dim MBType1 As Integer, MBType2 As Integer, MBType3 As Integer, Msg As String
  79.    Dim Msg1 As String, Msg2 As String, Msg3 As String, Msg4 As String
  80.    Msg1 = "Invalid Database File Name." & Chr(10) & "The file you specified ("
  81.    Msg2 = ") does not exist."
  82.    Msg3 = "Error opening database file "
  83.    Msg4 = "." & Chr(10) & "The database may already be in use by another user."
  84.    MBType1 = MB_RETRYCANCEL + MB_ICONEXCLAMATION + MB_DEFBUTTON1 + MB_APPLMODAL
  85.    MBType2 = MB_OK + MB_ICONSTOP + MB_DEFBUTTON1 + MB_APPLMODAL
  86.    MBType3 = MB_YESNOCANCEL + MB_ICONQUESTION + MB_DEFBUTTON1 + MB_APPLMODAL
  87.    On Error GoTo LocateMSAccessErrorHandler
  88.    CommonForm.CMDialog1.InitDir = PathNamePart(MSAccessPath)
  89.    CommonForm.CMDialog1.Filename = FileNamePart(MSAccessPath)
  90.    CommonForm.CMDialog1.DialogTitle = "Specify MSARN200.EXE or MSACCESS.EXE Location"
  91.    CommonForm.CMDialog1.FilterIndex = 6
  92.    CommonForm.CMDialog1.Flags = OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST
  93. LocateMSAccessTryAgain:
  94.    CommonForm.CMDialog1.Action = 1
  95.    On Error GoTo 0
  96.    MSAccessPath = CommonForm.CMDialog1.Filename
  97.    Screen.MousePointer = HOURGLASS
  98.    If MSAccessPath <> "" And FileExist(MSAccessPath) Then
  99.       'Do Nothing
  100.    ElseIf PatchDBName <> "" Then
  101.       MsgBox Msg1 & MSAccessPath & Msg2, MBType2, "IPS DB Patch"
  102.    End If
  103.  
  104. LocateMSAccessExit:
  105.    Screen.MousePointer = DEFAULT
  106. Exit Sub
  107.  
  108. LocateMSAccessError:
  109.    ErrSave = Err
  110.    MsgBox Msg3 & MSAccessPath & Msg4 & Chr$(10) & Error$, MBType2, "IPS DB Patch"
  111.    Screen.MousePointer = DEFAULT
  112.    Exit Sub
  113.  
  114.  
  115. LocateMSAccessErrorHandler:
  116.    ErrSave = Err
  117.    DBFNum = 0
  118.    If ErrSave = CDERR_CANCEL Then
  119.       Resume LocateMSAccessExit
  120.    ElseIf ErrSave = CDERR_DISKNOTREADY Then
  121.       Msg = Error$ & Chr(10) & Chr(10) & "Make sure the disk is ready and select 'RETRY', or select 'CANCEL'"
  122.       Select Case MsgBox(Msg, MBType1, "IPS DB Patch")
  123.       Case IDCANCEL
  124.      Resume LocateMSAccessExit
  125.       Case IDRETRY
  126.      Resume LocateMSAccessTryAgain
  127.       End Select
  128.    Else
  129.       Screen.MousePointer = DEFAULT
  130.       Exit Sub
  131.    End If
  132.  
  133. End Sub
  134.  
  135. Sub OpenInputDB ()
  136.    Dim ErrSave As Integer
  137.    Dim MBType1 As Integer, MBType2 As Integer, MBType3 As Integer, Msg As String
  138.    Dim Msg1 As String, Msg2 As String, Msg3 As String, Msg4 As String
  139.    Msg1 = "Invalid Database File Name." & Chr(10) & "The file you specified ("
  140.    Msg2 = ") does not exist."
  141.    Msg3 = "Error opening database file "
  142.    Msg4 = "." & Chr(10) & "The database may already be in use by another user."
  143.    MBType1 = MB_RETRYCANCEL + MB_ICONEXCLAMATION + MB_DEFBUTTON1 + MB_APPLMODAL
  144.    MBType2 = MB_OK + MB_ICONSTOP + MB_DEFBUTTON1 + MB_APPLMODAL
  145.    MBType3 = MB_YESNOCANCEL + MB_ICONQUESTION + MB_DEFBUTTON1 + MB_APPLMODAL
  146.    If InputDBOpen Then
  147.       CloseInputDB
  148.    End If
  149.    If InputDBOpen Then
  150.       GoTo OpenInputDBExit
  151.    End If
  152.    On Error GoTo OpenInputDBErrorHandler
  153.    CommonForm.CMDialog1.InitDir = CurDir$
  154.    CommonForm.CMDialog1.Filename = "PATCHINP.MDB"
  155.    CommonForm.CMDialog1.DialogTitle = "Identify Input Database"
  156.    CommonForm.CMDialog1.FilterIndex = 2
  157.    CommonForm.CMDialog1.Flags = OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST
  158. OpenInputDBTryAgain:
  159.    CommonForm.CMDialog1.Action = 1
  160.    On Error GoTo 0
  161.    InputDBName = CommonForm.CMDialog1.Filename
  162.    Screen.MousePointer = HOURGLASS
  163.    If InputDBName <> "" And FileExist(InputDBName) Then
  164. 'Open the MS Access Database.
  165.       On Error GoTo OpenInputDBError
  166.       'Set InputDB = OpenDatabase(InputDBName, True, False)
  167.       On Error GoTo 0
  168.       InputDBOpen = True
  169.    ElseIf InputDBName <> "" Then
  170.       MsgBox Msg1 & InputDBName & Msg2, MBType2, "IPS DB Patch"
  171.    End If
  172.  
  173. OpenInputDBExit:
  174.    Screen.MousePointer = DEFAULT
  175. Exit Sub
  176.  
  177. OpenInputDBError:
  178.    ErrSave = Err
  179.    MsgBox Msg3 & InputDBName & Msg4 & Chr$(10) & Error$, MBType2, "IPS DB Patch"
  180.    Screen.MousePointer = DEFAULT
  181.    Exit Sub
  182.  
  183.  
  184. OpenInputDBErrorHandler:
  185.    ErrSave = Err
  186.    DBFNum = 0
  187.    If ErrSave = CDERR_CANCEL Then
  188.       Resume OpenInputDBExit
  189.    ElseIf ErrSave = CDERR_DISKNOTREADY Then
  190.       Msg = Error$ & Chr(10) & Chr(10) & "Make sure the disk is ready and select 'RETRY', or select 'CANCEL'"
  191.       Select Case MsgBox(Msg, MBType1, "IPS DB Patch")
  192.       Case IDCANCEL
  193.      Resume OpenInputDBExit
  194.       Case IDRETRY
  195.      Resume OpenInputDBTryAgain
  196.       End Select
  197.    Else
  198.       Screen.MousePointer = DEFAULT
  199.       Exit Sub
  200.    End If
  201.  
  202. End Sub
  203.  
  204. Sub OpenPatchDB ()
  205.    Dim ErrSave As Integer
  206.    Dim MBType1 As Integer, MBType2 As Integer, MBType3 As Integer, Msg As String
  207.    Dim Msg1 As String, Msg2 As String, Msg3 As String, Msg4 As String
  208.    Msg1 = "Invalid Database File Name." & Chr(10) & "The file you specified ("
  209.    Msg2 = ") does not exist."
  210.    Msg3 = "Error opening database file "
  211.    Msg4 = "." & Chr(10) & "The database may already be in use by another user."
  212.    MBType1 = MB_RETRYCANCEL + MB_ICONEXCLAMATION + MB_DEFBUTTON1 + MB_APPLMODAL
  213.    MBType2 = MB_OK + MB_ICONSTOP + MB_DEFBUTTON1 + MB_APPLMODAL
  214.    MBType3 = MB_YESNOCANCEL + MB_ICONQUESTION + MB_DEFBUTTON1 + MB_APPLMODAL
  215.    If PatchDBOpen Then
  216.       ClosePatchDB
  217.    End If
  218.    If PatchDBOpen Then
  219.       GoTo OpenPatchDBExit
  220.    End If
  221.    On Error GoTo OpenPatchDBErrorHandler
  222.    CommonForm.CMDialog1.InitDir = "C:\IPSLABOR"
  223.    CommonForm.CMDialog1.Filename = "IPSLABOR.MDB"
  224.    CommonForm.CMDialog1.DialogTitle = "Identify Database to Patch"
  225.    CommonForm.CMDialog1.FilterIndex = 2
  226.    CommonForm.CMDialog1.Flags = OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST
  227. OpenPatchDBTryAgain:
  228.    CommonForm.CMDialog1.Action = 1
  229.    On Error GoTo 0
  230.    PatchDBName = CommonForm.CMDialog1.Filename
  231.    Screen.MousePointer = HOURGLASS
  232.    If PatchDBName <> "" And FileExist(PatchDBName) Then
  233. 'Open the MS Access Database.
  234.       On Error GoTo OpenPatchDBError
  235.       'Set InputDB = OpenDatabase(PatchDBName, True, False)
  236.       On Error GoTo 0
  237.       PatchDBOpen = True
  238.    ElseIf PatchDBName <> "" Then
  239.       MsgBox Msg1 & PatchDBName & Msg2, MBType2, "IPS DB Patch"
  240.    End If
  241.  
  242. OpenPatchDBExit:
  243.    Screen.MousePointer = DEFAULT
  244. Exit Sub
  245.  
  246. OpenPatchDBError:
  247.    ErrSave = Err
  248.    MsgBox Msg3 & PatchDBName & Msg4 & Chr$(10) & Error$, MBType2, "IPS DB Patch"
  249.    Screen.MousePointer = DEFAULT
  250.    Exit Sub
  251.  
  252.  
  253. OpenPatchDBErrorHandler:
  254.    ErrSave = Err
  255.    DBFNum = 0
  256.    If ErrSave = CDERR_CANCEL Then
  257.       Resume OpenPatchDBExit
  258.    ElseIf ErrSave = CDERR_DISKNOTREADY Then
  259.       Msg = Error$ & Chr(10) & Chr(10) & "Make sure the disk is ready and select 'RETRY', or select 'CANCEL'"
  260.       Select Case MsgBox(Msg, MBType1, "IPS DB Patch")
  261.       Case IDCANCEL
  262.      Resume OpenPatchDBExit
  263.       Case IDRETRY
  264.      Resume OpenPatchDBTryAgain
  265.       End Select
  266.    Else
  267.       Screen.MousePointer = DEFAULT
  268.       Exit Sub
  269.    End If
  270. End Sub
  271.  
  272. Sub PatchDatabase ()
  273.    Dim iRet As Integer, InputPos As Integer, PatchPos As Integer, ShellCmd As String
  274.    Dim MBType1 As Integer, MBType2 As Integer, MBType3 As Integer, Msg As String
  275.    Dim Msg1 As String, Msg2 As String, Msg3 As String, Msg4 As String, I As Integer
  276.    Dim ItemStr As String, ItemName As String
  277.    Msg1 = "MS Access is already running."
  278.    Msg2 = "Please Terminate all copies of MS Access, then return here and select 'Retry'."
  279.    Msg3 = "Error opening database file "
  280.    Msg4 = "." & Chr(10) & "The database may already be in use by another user."
  281.    MBType1 = MB_RETRYCANCEL + MB_ICONEXCLAMATION + MB_DEFBUTTON1 + MB_APPLMODAL
  282.    MBType2 = MB_OK + MB_ICONSTOP + MB_DEFBUTTON1 + MB_APPLMODAL
  283.    MBType3 = MB_YESNOCANCEL + MB_ICONQUESTION + MB_DEFBUTTON1 + MB_APPLMODAL
  284.    InputDBName = CurDir$ + "\PATCHINP.MDB"
  285.    If Not FileExist(InputDBName) Then OpenInputDB
  286.    'Select DB File to be patched.
  287.    OpenPatchDB
  288.    MSAccessPath = PathNamePart(PatchDBName) + "\MSARN200.EXE"
  289.    LocateMSAccess
  290. StartMSAccess:
  291.    On Error Resume Next
  292.    DoEvents
  293.    MainForm.InputLink.LinkTimeout = 300
  294.    MainForm.InputLink.LinkTopic = "MSACCESS|System"
  295.    MainForm.InputLink.LinkItem = "Status"
  296.    MainForm.InputLink.LinkMode = LM_MANUAL
  297.    MainForm.InputLink.LinkRequest
  298.    If (MainForm.InputLink.Text = "Ready") Then
  299.       'pop an OK/CANCEL box asking user to shutdown MSACCESS first, then return here and press OK
  300.       Msg = Msg1 & Chr(10) & Chr(10) & Msg2
  301.       Select Case MsgBox(Msg, MBType1, "IPS DB Patch")
  302.       Case IDCANCEL
  303.      Exit Sub
  304.       Case IDRETRY
  305.      Resume StartMSAccess
  306.       End Select
  307.    End If
  308.    MainForm.InputLink.LinkMode = LM_NONE
  309.    On Error GoTo 0
  310.    If FileExist(MSAccessPath) Then
  311.       StatusDlg.Show
  312.       MainForm.Visible = False
  313.       StatusDlg.Label2.Caption = "Identifying Objects being Patched..."
  314.       StatusDlg.Label1.Caption = "Please Be Patient..."
  315.       StatusDlg.Refresh
  316.       Screen.MousePointer = HOURGLASS
  317.       ShellCmd = MSAccessPath + " " + InputDBName
  318.       If Shell(ShellCmd, MINIMIZEDWITHOUTFOCUS) Then
  319.      On Error Resume Next
  320.      MainForm.InputLink.LinkTopic = "MSACCESS|System"
  321.      MainForm.InputLink.LinkItem = "Status"
  322.      MainForm.InputLink.LinkMode = LM_MANUAL
  323.      While MainForm.InputLink.Text <> "Ready"
  324.         DoEvents
  325.         MainForm.InputLink.LinkTopic = "MSACCESS|System"
  326.         MainForm.InputLink.LinkItem = "Status"
  327.         MainForm.InputLink.LinkMode = LM_MANUAL
  328.         MainForm.InputLink.LinkRequest
  329.      Wend
  330.      MainForm.InputLink.LinkMode = LM_NONE
  331.      On Error GoTo 0
  332.       Else
  333.      MsgBox "Can't Start MS Access for Patch Input Database, Patch cannot be performed"
  334.      Exit Sub
  335.       End If
  336.       Call GetList(InputDBName, MainForm.InputLink, MainForm.InputTables, "TableList")
  337.       Call GetList(InputDBName, MainForm.InputLink, MainForm.InputQueries, "QueryList")
  338.       Call GetList(InputDBName, MainForm.InputLink, MainForm.InputForms, "FormList")
  339.       Call GetList(InputDBName, MainForm.InputLink, MainForm.InputReports, "ReportList")
  340.       Call GetList(InputDBName, MainForm.InputLink, MainForm.InputMacros, "MacroList")
  341.       Call GetList(InputDBName, MainForm.InputLink, MainForm.InputModules, "ModuleList")
  342.       MainForm.InputLink.LinkTopic = "MSACCESS|System"
  343.       MainForm.InputLink.LinkMode = LM_MANUAL
  344.       MainForm.InputLink.LinkExecute "[Quit]"
  345.       MainForm.InputLink.LinkMode = LM_NONE
  346.       
  347.       DoEvents
  348.       
  349.       StatusDlg.Label2.Caption = "Identifying Existing Database Objects..."
  350.       StatusDlg.Refresh
  351.       ShellCmd = MSAccessPath + " " + PatchDBName
  352.       If Shell(ShellCmd, MINIMIZEDWITHOUTFOCUS) Then
  353.      On Error Resume Next
  354.      While MainForm.PatchLink.Text <> "Ready"
  355.         DoEvents
  356.         MainForm.PatchLink.LinkTimeout = 300
  357.         MainForm.PatchLink.LinkTopic = "MSACCESS|System"
  358.         MainForm.PatchLink.LinkItem = "Status"
  359.         MainForm.PatchLink.LinkMode = LM_MANUAL
  360.         MainForm.PatchLink.LinkRequest
  361.      Wend
  362.      MainForm.PatchLink.LinkMode = LM_NONE
  363.      On Error GoTo 0
  364.       Else
  365.      MsgBox "Can't Start MS Access for Database being patched, Patch cannot be performed"
  366.      Exit Sub
  367.       End If
  368.       Call GetList(PatchDBName, MainForm.PatchLink, MainForm.PatchTables, "TableList")
  369.       Call GetList(PatchDBName, MainForm.PatchLink, MainForm.PatchQueries, "QueryList")
  370.       Call GetList(PatchDBName, MainForm.PatchLink, MainForm.PatchForms, "FormList")
  371.       Call GetList(PatchDBName, MainForm.PatchLink, MainForm.PatchReports, "ReportList")
  372.       Call GetList(PatchDBName, MainForm.PatchLink, MainForm.PatchMacros, "MacroList")
  373.       Call GetList(PatchDBName, MainForm.PatchLink, MainForm.PatchModules, "ModuleList")
  374.       
  375.       If ProceedWithUpdate() Then
  376.      'Patch the DB
  377.      StatusDlg.Label1.Caption = "Updating Database Objects in " + PatchDBName
  378.      StatusDlg.Label2.Caption = " "
  379.      StatusDlg.Refresh
  380.       
  381.      For I = 0 To (UpdateNotice.UpdateList.ListCount - 1) Step 1
  382.         ItemStr = UpdateNotice.UpdateList.List(I)
  383.         StatusDlg.Label2.Caption = ItemStr
  384.         StatusDlg.Refresh
  385.         If InStr(1, ItemStr, "Table Add ") = 1 Then
  386.            ItemName = Mid$(ItemStr, 16)
  387.            Call PatchObject(TABLE_OBJ, ItemName, False)
  388.         ElseIf InStr(1, ItemStr, "Table Update ") = 1 Then
  389.            ItemName = Mid$(ItemStr, 16)
  390.            Call PatchObject(TABLE_OBJ, ItemName, True)
  391.         ElseIf InStr(1, ItemStr, "Query Add ") = 1 Then
  392.            ItemName = Mid$(ItemStr, 16)
  393.            Call PatchObject(QUERY_OBJ, ItemName, False)
  394.         ElseIf InStr(1, ItemStr, "Query Update ") = 1 Then
  395.            ItemName = Mid$(ItemStr, 16)
  396.            Call PatchObject(QUERY_OBJ, ItemName, True)
  397.         ElseIf InStr(1, ItemStr, "Form Add ") = 1 Then
  398.            ItemName = Mid$(ItemStr, 15)
  399.            Call PatchObject(FORM_OBJ, ItemName, False)
  400.         ElseIf InStr(1, ItemStr, "Form Update ") = 1 Then
  401.            ItemName = Mid$(ItemStr, 15)
  402.            Call PatchObject(FORM_OBJ, ItemName, True)
  403.         ElseIf InStr(1, ItemStr, "Report Add ") = 1 Then
  404.            ItemName = Mid$(ItemStr, 17)
  405.            Call PatchObject(REPORT_OBJ, ItemName, False)
  406.         ElseIf InStr(1, ItemStr, "Report Update ") = 1 Then
  407.            ItemName = Mid$(ItemStr, 17)
  408.            Call PatchObject(REPORT_OBJ, ItemName, True)
  409.         ElseIf InStr(1, ItemStr, "Macro Add ") = 1 Then
  410.            ItemName = Mid$(ItemStr, 16)
  411.            Call PatchObject(MACRO_OBJ, ItemName, False)
  412.         ElseIf InStr(1, ItemStr, "Macro Update ") = 1 Then
  413.            ItemName = Mid$(ItemStr, 16)
  414.            Call PatchObject(MACRO_OBJ, ItemName, True)
  415.         ElseIf InStr(1, ItemStr, "Module Add ") = 1 Then
  416.            ItemName = Mid$(ItemStr, 17)
  417.            Call PatchObject(MODULE_OBJ, ItemName, False)
  418.         ElseIf InStr(1, ItemStr, "Module Update ") = 1 Then
  419.            ItemName = Mid$(ItemStr, 17)
  420.            Call PatchObject(MODULE_OBJ, ItemName, True)
  421.         End If
  422.         'UpdateNotice.UpdateList.AddItem ItemStr
  423.      Next I
  424.      
  425.       End If
  426.       
  427.       
  428.       Unload UpdateNotice
  429.       
  430.       On Error Resume Next
  431.       MainForm.PatchLink.LinkTopic = "MSACCESS|System"
  432.       MainForm.PatchLink.LinkMode = LM_MANUAL
  433.       MainForm.PatchLink.LinkExecute "[Quit]"
  434.       MainForm.PatchLink.LinkMode = LM_NONE
  435.       On Error GoTo 0
  436.       Unload StatusDlg
  437.       Screen.MousePointer = DEFAULT
  438.       AboutBox.ProgLabel.Caption = "IPSLABOR Patch Update Completed!"
  439.       AboutBox.VersionLabel.Caption = " "
  440.       AboutBox.DBLabel.Caption = " "
  441.       AboutBox.Show MODAL
  442.       Unload MainForm
  443.    Else
  444.       MsgBox "Can't find MS Access, Patch cannot be performed"
  445.       Exit Sub
  446.    End If
  447. End Sub
  448.  
  449. Sub PatchObject (Obj_Type As Integer, ItemName As String, Del_Existing As Integer)
  450.    Dim XfrString As String, ClsString As String, DelString As String
  451.    If Del_Existing Then
  452.       ClsString = "[Close " + Str$(Obj_Type) + " ,""" + ItemName + """]"
  453.       DelString = "[DeleteObject " + Str$(Obj_Type) + " ,""" + ItemName + """]"
  454.       MainForm.PatchLink.LinkTopic = "MSAccess|" + PatchDBName
  455.       MainForm.PatchLink.LinkMode = LM_MANUAL
  456.       MainForm.PatchLink.LinkExecute ClsString
  457.       MainForm.PatchLink.LinkExecute DelString
  458.       MainForm.PatchLink.LinkMode = LM_NONE
  459.    End If
  460.    XfrString = "[TransferDatabase , ""Microsoft Access"", """ + InputDBName + """ ," + Str$(Obj_Type) + ", """ + ItemName + """, """ + ItemName + """]"
  461.    MainForm.PatchLink.LinkTopic = "MSAccess|" + PatchDBName
  462.    MainForm.PatchLink.LinkMode = LM_MANUAL
  463.    MainForm.PatchLink.LinkExecute XfrString
  464.    MainForm.PatchLink.LinkMode = LM_NONE
  465. End Sub
  466.  
  467. Function ProceedWithUpdate () As Integer
  468.    Dim I As Integer, ItemStr As String
  469.    For I = 0 To (MainForm.InputForms.ListCount - 1) Step 1
  470.       ItemStr = MainForm.InputForms.List(I)
  471.       If InList(MainForm.PatchForms, ItemStr) Then
  472.      ItemStr = "Form Update - " + ItemStr
  473.       Else
  474.      ItemStr = "Form Add    - " + ItemStr
  475.       End If
  476.       UpdateNotice.UpdateList.AddItem ItemStr
  477.    Next I
  478.    
  479.    For I = 0 To (MainForm.InputReports.ListCount - 1) Step 1
  480.       ItemStr = MainForm.InputReports.List(I)
  481.       If InList(MainForm.PatchReports, ItemStr) Then
  482.      ItemStr = "Report Update - " + ItemStr
  483.       Else
  484.      ItemStr = "Report Add    - " + ItemStr
  485.       End If
  486.       UpdateNotice.UpdateList.AddItem ItemStr
  487.    Next I
  488.    
  489.    For I = 0 To (MainForm.InputMacros.ListCount - 1) Step 1
  490.       ItemStr = MainForm.InputMacros.List(I)
  491.       If InList(MainForm.PatchMacros, ItemStr) Then
  492.      ItemStr = "Macro Update - " + ItemStr
  493.       Else
  494.      ItemStr = "Macro Add    - " + ItemStr
  495.       End If
  496.       UpdateNotice.UpdateList.AddItem ItemStr
  497.    Next I
  498.    
  499.    For I = 0 To (MainForm.InputTables.ListCount - 1) Step 1
  500.       ItemStr = MainForm.InputTables.List(I)
  501.       If InList(MainForm.PatchTables, ItemStr) Then
  502.      ItemStr = "Table Update - " + ItemStr
  503.       Else
  504.      ItemStr = "Table Add    - " + ItemStr
  505.       End If
  506.       UpdateNotice.UpdateList.AddItem ItemStr
  507.    Next I
  508.    
  509.    For I = 0 To (MainForm.InputQueries.ListCount - 1) Step 1
  510.       ItemStr = MainForm.InputQueries.List(I)
  511.       If InList(MainForm.PatchQueries, ItemStr) Then
  512.      ItemStr = "Query Update - " + ItemStr
  513.       Else
  514.      ItemStr = "Query Add    - " + ItemStr
  515.       End If
  516.       UpdateNotice.UpdateList.AddItem ItemStr
  517.    Next I
  518.    
  519.    For I = 0 To (MainForm.InputModules.ListCount - 1) Step 1
  520.       ItemStr = MainForm.InputModules.List(I)
  521.       If InList(MainForm.PatchModules, ItemStr) Then
  522.      ItemStr = "Module Update - " + ItemStr
  523.       Else
  524.      ItemStr = "Module Add    - " + ItemStr
  525.       End If
  526.       UpdateNotice.UpdateList.AddItem ItemStr
  527.    Next I
  528.  
  529.    Screen.MousePointer = NORMAL
  530.    UpdateNotice.Show MODAL
  531.    Screen.MousePointer = HOURGLASS
  532.  
  533.    ProceedWithUpdate = ProceedChoice
  534.  
  535. End Function
  536.  
  537. Function TableOpen (db As Database, tbl As Table, tblName As String) As Integer
  538.    Dim MBType1 As Integer, Msg1 As String, Msg2 As String, ErrSave As Integer
  539.    MBType1 = MB_OK + MB_ICONSTOP + MB_DEFBUTTON1 + MB_APPLMODAL
  540.    Msg1 = "Error opening Database Table "
  541.    Msg2 = "." & Chr(10) & "The table may already be in use by another user."
  542.    TableOpen = False
  543.    On Error GoTo TBLOpenError
  544.    'Set tbl = db.OpenTable(tblName)
  545.    TableOpen = True
  546.    Exit Function
  547.  
  548. TBLOpenError:
  549.    ErrSave = Err
  550.    MsgBox Msg1 & tblName & Msg2 & Chr$(10) & Chr$(10) & Error$, MBType1, "IPS DB Patch"
  551.    Exit Function
  552. End Function
  553.  
  554.