Êàê íàïèñàòü êîììåð÷åñêîå ïðèëîæåíèå íà Access

Èñòî÷íèê: 5codelines

Õî÷ó ïðåäñòàâèòü Âàì ôóíêöèè, áåç êîòîðûõ íîðìàëüíàÿ æèçíü ïðîãðàììû íà MS Access íå âîçìîæíî.

Èõ âñåãî òðè:

  • CM_LT_AddAllExt() - äîáàâëÿåò â òåêóùóþ áàçó ññûëêè íà òàáëèöû èç mdb ôàéëà
  • CM_LT_AddAllExt_ODBC() - äîáàâëÿåò â òåêóùóþ áàçó ññûëêè íà ODBC òàáëèöû íà ñåðâåðå
  • CM_LT_DelAll() - óäàëÿåò òàáëèöû-ññûëêè èç òåêóùåé áàçû

Îíè ïîçâîëÿþò ñîçäàòü â èíòåðôåéñíîé áàçå ññûëêè íà òàáëèöû èç áàçû ñ äàííûì. Ó ìåíÿ îíè çàïóñêàþòñÿ êàæäûé ðàç ïðè çàïóñêå. Íàïèñàíû îíè äàâíûì äàâíî, íî ïîëåçíû äî ñèõ ïîð.

Òåêñò ôóíêöèé:

view plain copy to clipboard print
  1. Public Function CM_LT_AddAllExt(ByVal stPathToBase As String) As Long  
  2. ' <Ñêîêîâ Ñ.À.> ñîçäàíà: 2004-02-05  
  3. ' ïîäëèíêîâûâàåò âñå òàáëèöû èç óêàçàííîé áàçû  
  4. ' ïðîâåðÿåò ñóùåñòâóåò ëè ïîäëèíêîâûâàåìàÿ òàáëèöà â òåêóùåé êàê ññûëêà, òî îáíîâëÿåòñÿ ñòðîêà ïîäêëþ÷åíèÿ.  
  5. ' åñëè æå â òåê. áàçå åñòü òàáëèöà ñ òàêèì èìåíåì (íå ññûëêà), òî ïîäëèíêîâûâàåìàÿ òàáëèöà ïðîïóñêàåòñÿ  
  6. ' ò.î. ïåðåä âûçîâîì ýòîé ôóíêöèè óäàëÿòü ëèíêîâàííûå òàáëèöû íå íóæíî  
  7. ' âõîä: stPathToBase - ïóòü è èìÿ áàçû  
  8. ' âûõîä: êîëè÷åñòâî íå ïîäëèíêîâàííûõ òàáëèö, â ñëó÷àå îøèáêè âîçâðàùàåò -1  
  9.   
  10. On Error GoTo Err_  
  11.     CM_LT_AddAllExt = 0  
  12.   
  13.     Dim tdf As TableDef  
  14.     Dim db As Database  
  15.     Dim bIsSysOrLink As Boolean  
  16.     Dim stNameTbl As String  
  17.     Dim lCountNotLinket As Long ' êîëè÷åñòâî íå ïîäëèíêîâàííûõ òàáëèö  
  18.     Dim stConnect As String  
  19.     Dim dbCur As DAO.Database  
  20.     Dim tdfNew As DAO.TableDef  
  21.     Dim tdfsCur As DAO.TableDefs  
  22.   
  23.     stConnect = ";DATABASE=" & stPathToBase  
  24.     Set dbCur = CurrentDb  
  25.     Set tdfsCur = dbCur.TableDefs  
  26.   
  27.     '-- äåëàåì ìàñèâ òàáëèö â òåêóùåé áàçå  
  28.     Dim masNameTbl() As String  
  29.     Dim i As Long  
  30.   
  31.     tdfsCur.Refresh  
  32.     ReDim masNameTbl(tdfsCur.count - 1)  
  33.     i = 0  
  34.     For Each tdf In tdfsCur  
  35.         masNameTbl(i) = tdf.Name  
  36.         i = i + 1  
  37.     Next tdf  
  38.   
  39.     '-- êîííåêòèìñÿ ê áàçå  
  40.     Set db = OpenDatabase(stPathToBase)  
  41.   
  42.     lCountNotLinket = 0  
  43.     '-- ëèíêóåì  
  44.     For Each tdf In db.TableDefs  
  45.         bIsSysOrLink = (tdf.Attributes And dbSystemObject) Or _  
  46.                     (tdf.Attributes And dbHiddenObject) _  
  47.                     Or (tdf.Attributes And dbAttachedTable) ' ñèñòåìíàÿ èëè ïðèñåîåäèíåííàÿ ëè?  
  48.   
  49.         If Not bIsSysOrLink Then  ' åñëè íå òî ÷òî âûøå, òî ìîæíî äåëàòü ëèíê  
  50.             stNameTbl = tdf.Name  
  51.             '-- åñëè òàêàÿ òàáëèöà ñóùåñòâóåò â òåêóùåé áàçå  
  52.             If SerchStrInMas(masNameTbl, stNameTbl) <> -1 Then  
  53.                 '-- òî ïðîâåðÿåì ïîäëèíêîâàíàÿ ëè? èíà÷å ïðîïóñêàåì ýòó òàáëèöó è ïåðåõîäèì íà ñëåäóþùóþ  
  54.                 If (tdfsCur(stNameTbl).Attributes And dbAttachedTable) Then  
  55.                     '-- îáíîâëÿåì ïóòü ê áä  
  56.                     tdfsCur(stNameTbl).Connect = stConnect  
  57.                     tdfsCur(stNameTbl).RefreshLink  
  58.                 Else  
  59.                     Debug.Print "CM_LT_AddAllExt(), ïðîïóùåíà òàáëèöà:", stNameTbl  
  60.                     lCountNotLinket = lCountNotLinket + 1  
  61.                 End If  
  62.             Else  
  63.                 '-- íå ñóùåñòâóåò - òî ëèíêóåì  
  64.                 Set tdfNew = dbCur.CreateTableDef(stNameTbl)  
  65.                 tdfNew.SourceTableName = stNameTbl  
  66.                 tdfNew.Connect = stConnect  
  67.                 tdfsCur.Append tdfNew  
  68.             End If  
  69.         End If  
  70.     Next tdf  
  71.   
  72.     db.Close  
  73.     Set db = Nothing  
  74.   
  75.     tdfsCur.Refresh  
  76.     Set tdfsCur = Nothing  
  77.     Set dbCur = Nothing  
  78.   
  79.     CM_LT_AddAllExt = lCountNotLinket  
  80. Exit_:  
  81.     Exit Function  
  82.   
  83. Err_:  
  84.     CM_LT_AddAllExt = -1  
  85.     Err.Raise Err.Number, "CM_LT_AddAllExt()->" & Err.Source, Err.Description '-- ïåðåäàåì îøèáêó â âûçâàâøóþ ôóíêöèþ  
  86.   
  87.     Resume Exit_  
  88. End Function  
  89.   
  90. Private Function SerchStrInMas(ByRef masStr() As String, ByRef SerchStr As String) As Long  
  91. ' <Ñêîêîâ Ñ.À.> ñîçäàíà: 2004-02-05  
  92.   
  93. ' Ïîèñê ñòðîêè â ñòðîêîâîì ìàññèâå  
  94. ' âõîä: masStr - ìàññèâ ñòðîê  
  95. '       SerchStr - èñêîìàÿ ñòðîêà  
  96. ' âûõîä:  
  97. '   íîìåð ýëåìåíòà ìàññèâà, â êîòîðîì áûëà íàéäåíà ïîäñòðîêà SerchStr, èíà÷å -1 (êîãäà íåò ñîâïàäåíèé)  
  98. '   ïðè îøèáêå âîçâðàùàåò -1  
  99.   
  100. On Error GoTo Err_  
  101.   
  102.     Dim i As Long  
  103.   
  104.     SerchStrInMas = -1  
  105.   
  106.     For i = LBound(masStr) To UBound(masStr)  
  107.         If masStr(i) = SerchStr Then  
  108.             SerchStrInMas = i  
  109.             Exit For  
  110.         End If  
  111.     Next i  
  112.   
  113. Exit_:  
  114.     Exit Function  
  115. Err_:  
  116.     SerchStrInMas = -1  
  117.     Resume Exit_  
  118. End Function  
  119.   
  120. Public Function CM_LT_AddAllExt_ODBC(ByVal stConnectStr As String) As Long  
  121. ' <Êóëàãà Ñ.Þ.> ñîçäàíà: 2006-10-12  
  122.   
  123. '   ïîäëèíêîâûâàåò âñå òàáëèöû èç óêàçàííîé áàçû  
  124. '   ïðîâåðÿåò ñóùåñòâóåò ëè ïîäëèíêîâûâàåìàÿ òàáëèöà â òåêóùåé êàê ññûëêà, òî óäàëÿåò.  
  125. '   åñëè æå ýòî ÿâëÿåòñÿ òàáëèöåé, òî ïîäëèíêîâûâàåìàÿ òàáëèöà ïðîïóñêàåòñÿ  
  126. '   ò.å. ïåðåä âûçîâîì ýòîé ôóíêöèè óäàëÿòü ëèíêîâàííûå òàáëèöû íå íóæíî, îí óäàëèòü íåîáõîäèìûå ñàìà  
  127. ' âõîä: stConnectStr - ñòðîêà ïîäêëþ÷åíèÿ ADO  
  128. ' âûõîä: êîëè÷åñòâî íå ïîäëèíêîâàííûõ òàáëèö, â ñëó÷àå îøèáêè âîçâðàùàåò -1  
  129.   
  130. On Error GoTo Err_  
  131.     CM_LT_AddAllExt_ODBC = 0  
  132.   
  133.     Dim bIsSysOrLink As Boolean  
  134.     Dim stNameTbl As String  
  135.     Dim tdf As TableDef  
  136.     Dim lCountNotLinket As Long ' êîëè÷åñòâî íå ïîäëèíêîâàííûõ òàáëèö  
  137.     Dim cnn As ADODB.Connection  
  138.     Dim rst As ADODB.Recordset  
  139.     Dim stConnectTbl As String  
  140.     Dim dbCur As DAO.Database  
  141.     Dim tdfNew As DAO.TableDef  
  142.     Dim tdfsCur As DAO.TableDefs  
  143.   
  144.     stConnectTbl = "ODBC;" & stConnectStr  
  145.     Set dbCur = CurrentDb  
  146.     Set tdfsCur = dbCur.TableDefs  
  147.   
  148.     ' äåëàåì ìàñèâ òàáëèö â òåêóùåé áàçå  
  149.     Dim masNameTbl() As String  
  150.     Dim i As Long  
  151.   
  152.     ReDim masNameTbl(tdfsCur.count - 1)  
  153.     i = 0  
  154.     For Each tdf In tdfsCur  
  155.         masNameTbl(i) = tdf.Name  
  156.         i = i + 1  
  157.     Next tdf  
  158.   
  159.     ' êîííåêòèìñÿ ê áàçå  
  160.     Set cnn = New ADODB.Connection  
  161.     cnn.Open (stConnectStr)  
  162.     Set rst = cnn.OpenSchema(adSchemaTables)  
  163.   
  164.     lCountNotLinket = 0  
  165.     ' ëèíêóåì  
  166.     Do While Not rst.EOF  
  167.         stNameTbl = rst("TABLE_NAME")  
  168.         ' åñëè òàêàÿ òàáëèöà ñóùåñòâóåò â òåêóùåé áàçå  
  169.         If SerchStrInMas(masNameTbl, stNameTbl) <> -1 Then  
  170.             ' òî ïðîâåðÿåì ëèíêîâàíàÿ ëè? èíà÷å ïðîïóñàåì ýòó òàáëèöó è ïåðåõîäèì íà ñëåäóþùóþ  
  171.             If (tdfsCur(stNameTbl).Attributes And (dbAttachedTable + dbAttachedODBC)) Then  
  172.                 '-- îáíîâëÿåì ïóòü ê áä  
  173.                 tdfsCur(stNameTbl).Connect = stConnectTbl  
  174.                 tdfsCur(stNameTbl).RefreshLink  
  175.             Else  
  176.                 Debug.Print "CM_LT_AddAllExt_ODBC(), ïðîïóùåíà òàáëèöà:", stNameTbl  
  177.                 lCountNotLinket = lCountNotLinket + 1  
  178.             End If  
  179.         Else  
  180.             '-- íå ñóùåñòâóåò - òî ëèíêóåì  
  181.             Set tdfNew = dbCur.CreateTableDef(stNameTbl)  
  182.             tdfNew.SourceTableName = stNameTbl  
  183.             tdfNew.Connect = stConnectTbl  
  184.             tdfsCur.Append tdfNew  
  185.         End If  
  186.         rst.MoveNext  
  187.     Loop  
  188.   
  189.     tdfsCur.Refresh  
  190.     Set tdfsCur = Nothing  
  191.     Set dbCur = Nothing  
  192.   
  193.     rst.Close  
  194.     cnn.Close  
  195.     CM_LT_AddAllExt_ODBC = lCountNotLinket  
  196.   
  197. Exit_:  
  198.     Exit Function  
  199.   
  200. Err_:  
  201.     Err.Raise Err.Number, "CM_LT_AddAllExt_ODBC()->" & Err.Source, Err.Description '-- ïåðåäàåì îøèáêó â âûçâàâøóþ ôóíêöèþ  
  202.     CM_LT_AddAllExt_ODBC = -1  
  203.     Resume Exit_  
  204. End Function  
  205.   
  206. Public Function CM_LT_DelAll() As Boolean  
  207. ' <Ñêîêîâ Ñ.À.> ñîçäàíà: 2003-12-12  
  208.   
  209. ' óäàëÿåò âñå ñâÿçàíûå òàáëèöû â òåêóùåé áàçå  
  210.   
  211. On Error GoTo Err_  
  212.   
  213.     Dim tdf As TableDef  
  214.     Dim db As Database  
  215.     Dim bIsAttached As Boolean  
  216.   
  217.     Set db = CurrentDb  
  218.   
  219.     For Each tdf In db.TableDefs  
  220.         bIsAttached = (tdf.Attributes And dbAttachedODBC) _  
  221.                 Or (tdf.Attributes And dbAttachedTable) ' ïðèñåîåäèíåííàÿ òàáëèöà îáûêíîâåííàÿ èëè ODBC  
  222.   
  223.         If bIsAttached Then ' óäàëÿåì òîëüêî ïðèëèíêîâàííûå  
  224.             DoCmd.DeleteObject acTable, tdf.Name  
  225.         End If  
  226.     Next  
  227.   
  228.     Set db = Nothing  
  229.     CM_LT_DelAll = True  
  230. Exit_:  
  231.     Exit Function  
  232. Err_:  
  233.     CM_LT_DelAll = False  
  234.   
  235.     Err.Raise Err.Number, "CM_LT_DelAll()->" & Err.Source, Err.Description '-- ïåðåäàåì îøèáêó â âûçâàâøóþ ôóíêöèþ  
  236.     Resume Exit_  
  237. End Function  

Äî âñòðå÷è!


Ñòðàíèöà ñàéòà http://www.interface.ru
Îðèãèíàë íàõîäèòñÿ ïî àäðåñó http://www.interface.ru/home.asp?artId=26026