VB6到VB2008

VB6到VB2008

关注
发信
关注(28)粉丝(399)

VB6到VB2008_DAO_TO_ADO SQL SEVER

本文介绍了VB6到VB2008_DAO_TO_ADO SQL SEVER的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 29岁程序员，3月因学历无情被辞！ 任何人都可以在vb2008上重写此代码并将连接转换为sql server exp 此功能以节省销售发票   1617  Public Sub Save_Data()   1618   将Tab1，Tab2，Tab3设为记录集   1619    Dim Str As String   1620    Doc DocNo As Long   1621   将TValue变暗为Double      1629   设置TmpTab = DB1.OpenRecordset(从DocNo从Doc ORDER中选择DocNo"，dbOpenSnapshot)   1630   如果不是TmpTab.EOF，那么   1631       TmpTab.MoveLast   1632       DayNo = TmpTab(0)+ 1   1633   其他   1634        DayNo = 1   1635   如果结束   1636    TmpTab.Close   1637   将TmpTab设置为Nothing   1638     1639   如果不是EMode，则退出Sub   1640      1641    Screen.MousePointer = vbHourglass   1642   出现错误时转到CancelSesion   1643    WorkData.BeginTrans   1644      1645   设置Tab1 = DB1.OpenRecordset("SELECT * FROM"& Trim(TName)&"WHERE DocNo ="& txtFields(0).Text，dbOpenDynaset) 1646   如果是Tab1.EOF，则   1647       Tab1.AddNew   1648   其他   1649       DB1.执行"DELETE * FROM SalInv_Sub WHERE DocNo =" & Tab1(0)   1650        1651       致电DocDelTran   1652        1653       如果Tab1(13)= 1那么   1654          Str =从CustTran处删除*"   1655          Str = Str& " DocNo =" & Tab1(0)   1656         Str = Str& " AND DocType = 1""   1657          Str = Str& " AND CustCode ="& Tab1(5)   1658          DB1.Execute Str   1659       ElseIf Tab1(13)= 2然后   1660 0......................................................... Str =从CustVendTran WHERE中删除*"   1661         Str = Str& " DocNo =" & Tab1(0)   1662          Str = Str& " AND DocType = 1""   1663年         Str = Str& " AND CustCode ="& Tab1(5)   1664         DB1.Execute Str   1665年如果结束   1666        1667       Str =删除*从ItemTran WHERE处"   1668       Str = Str& " DocNo =" & Tab1(0)   1669       Str = Str& " AND DocType = 4""   1670       DB1.Execute Str   1671               1672       如果Tab1(13)= 1那么   1673         如果Tab1(2)= 1或Tab1(2)= 3，则   1674                                    TValue = Tab1(7)-Tab1(9)+ Tab1(10)-Tab1(11)   1675            设置Tab2 = DB1.OpenRecordset(从客户WHERE代码中选择TValue =& Tab1(5)，dbOpenDynaset)   1676                                   如果不是Tab2.EOF，则   1677            Tab2.MoveFirst   1678            Tab2.Edit   1679年            Tab2(0)= Tab2(0)-TValue   1680            Tab2.Update   1681           如果结束   1682            Tab2.Close   1683年                                   设置Tab2 = Nothing   1684         如果结束   1685       ElseIf Tab1(13)= 2然后   1686        如果Tab1(2)= 1或Tab1(2)= 3，则   1687            TValue = Tab1(7)-Tab1(9)+ Tab1(10)-Tab1(11)   1688           设置Tab2 = DB1.OpenRecordset(从CustVend WHERE代码中选择TValue =& Tab1(5)，dbOpenDynaset)   1689           如果不是Tab2.EOF，则   1690            Tab2.MoveFirst   1691年            Tab2.Edit   1692            Tab2(0)= Tab2(0)-TValue   1693             Tab2.Update   1694           如果结束   1695年Tab2.Close   1696      设置Tab2 = Nothing   1697         如果结束   1698    如果结束   1699        1700      如果Tab1(2)> 1然后   1701         Str ="SELECT * FROM从接收地点"   1702          Str = Str& " DocNo =" & Tab1(14)   1703          Str = Str& " AND CACode ="& Tab1(5)   1704          Str = Str& " AND InvNo ="& Tab1(0)   1705         设置Tab2 = DB1.OpenRecordset(Str，dbOpenDynaset)   1706         如果不是Tab2.EOF，则   1707           如果Tab1(13)= 1那么   1708             Str =从CustTran处删除*"   1709             Str = Str& " DocNo =" & Tab2(0)   1710             Str = Str& " AND DocType = 2""   1711             Str = Str& " AND CustCode ="& Tab2(4)   1712               DB1.Execute Str   1713      ElseIf Tab1(13)= 2然后   1714             Str =从CustVendTran WHERE中删除*"   1715             Str = Str& " DocNo =" & Tab2(0)   1716             Str = Str& " AND DocType = 5""   1717             Str = Str& " AND CustCode ="& Tab2(4)   1718             DB1.Execute Str   1719年      如果结束   1720                            1721年        Str =从* CasherTran处删除*"   1722年        Str = Str& " DocNo =" & Tab2(0)   1723年        Str = Str& " AND DocType = 3""   1724       Str = Str& " AND ExpCode = 0"   1725 Str = Str& " AND CasherCode ="& Tab2(5)   1726       DB1.Execute Str   1727年   1728        Str ="DELETE * FROM Rec_Sub WHERE"   1729年        Str = Str& " DocNo =" & Tab2(0)   1730            DB1.Execute Str   1731           1732         如果结束   1733年Tab2.Close   1734         设置Tab2 = Nothing   1735           1736          Str ="DELETE * FROM FROM Recieve WHERE"   1737         Str = Str& " DocNo =" & Tab1(14)   1738          Str = Str& " AND CACode ="& Tab1(5)   1739          Str = Str& " AND InvNo ="& Tab1(0)   1740          Str = Str& " AND DocCase = 1""   1741          DB1.Execute Str   1742                                     1743      如果结束   1744       Tab1.Edit   1745年如果结束   1746        1747   致电DocAddTran(1)   1748   1749   设置TmpTab = DB1.OpenRecordset(从DocNo从Doc ORDER中选择DocNo"，dbOpenSnapshot)   1750   如果不是TmpTab.EOF，那么   1751      TmpTab.MoveLast   1752年      DayNo = TmpTab(0)+ 1   1753   其他   1754年      DayNo = 1   1755   如果结束   1756    TmpTab.Close   1757   将TmpTab设置为Nothing   1758   1759   致电DocAddTran(2)   1760   1761   如果Combo1.ListIndex = 1或Combo1.ListIndex = 2，则   1762       设置TmpTab = DB1.OpenRecordset(从DocNo从Doc ORDER中选择DocNo"，dbOpenSnapshot)   1763年如果不是TmpTab.EOF，那么   1764          TmpTab.MoveLast   1765          DayNo = TmpTab(0)+ 1   1766年其他   1767         DayNo = 1   1768      如果结束   1769      TmpTab.Close   1770     将TmpTab设置为Nothing   1771年致电DocAddTran(3)   1772   如果结束   1773年   1774年如果Combo4.ListIndex = 0，则   1775年设置Tab3 = DB1.OpenRecordset("SELECT * FROM CustTran"，dbOpenDynaset)   1776年Tab3.AddNew   1777     Tab3(0)= IIf(txtFields(0).Text<>"，txtFields(0).Text，0)   1778       Tab3(1)= 1   1779        Tab3(2)= DTP1.Value   1780 0........................................... Tab3(3)= IIf(txtFields(3).Text<>"，txtFields(3).Text，0)   1781年Tab3(4)= IIf(txtFields(19).Text<>"，txtFields(19).Text，0)   1782     Tab3(5)=发票编号& txtFields(0).Text   1783年Tab3.Update   1784年Tab3.Close   1785      设置Tab3 = Nothing   1786    ElseIf Combo4.ListIndex = 1然后   1787年设置Tab3 = DB1.OpenRecordset("SELECT * FROM CustVendTran"，dbOpenDynaset)   1788      Tab3.AddNew   1789年Tab3(0)= IIf(txtFields(0).Text<>"，txtFields(0).Text，0)   1790      Tab3(1)= 1   1791年      Tab3(2)= DTP1.Value   1792     Tab3(3)= IIf(txtFields(3).Text<>"，txtFields(3).Text，0)   1793年Tab3(4)= IIf(txtFields(19).Text<>"，txtFields(19).Text，0)   1794        Tab3(5)=发票编号" & txtFields(0).Text   1795年Tab3.Update   1796年Tab3.Close   1797    设置Tab3 = Nothing   1798   如果结束   1799     1800   如果Combo4.ListIndex = 0，则   1801      如果Combo1.ListIndex = 0或Combo1.ListIndex = 2，则   1802          TValue = Val(txtFields(19).Text)-Val(txtFields(13).Text)   1803         设置Tab3 = DB1.OpenRecordset("从客户WHERE代码中选择TValue =& txtFields(3).Text，dbOpenDynaset)   1804         如果不是Tab3.EOF，则   1805年        Tab3.MoveFirst   1806年Tab3.Edit   1807年        Tab3(0)= Tab3(0)+ TValue   1808            Tab3.Update   1809        如果结束   1810         Tab3.Close   1811         设置Tab3 = Nothing   1812      如果结束   1813    ElseIf Combo4.ListIndex = 1然后   1814年如果Combo1.ListIndex = 0或Combo1.ListIndex = 2，则   1815          TValue = Val(txtFields(19).Text)-Val(txtFields(13).Text)   1816         设置Tab3 = DB1.OpenRecordset("从CustVend WHERE代码中选择TValue =& txtFields(3).Text，dbOpenDynaset)   1817         如果不是Tab3.EOF，则   1818                                              Tab3.MoveFirst   1819                                              Tab3.Edit   1820            Tab3(0)= Tab3(0)+ TValue   1821年Tab3.Update   1822年如果结束   1823          Tab3.Close   1824        设置Tab3 = Nothing   1825年如果结束   1826年如果结束   1827     1828   如果Combo1.ListIndex = 1，则   1829       TValue = Val(txtFields(19).Text)   1830年ElseIf Combo1.ListIndex = 2然后   1831      TValue = Val(txtFields(13).Text)   1832   如果结束   1833年如果Combo1.ListIndex> 0然后   1834年设置Tab3 = DB1.OpenRecordset("SELECT * FROM DocNo接收订单"，dbOpenDynaset)   1835年如果不是Tab3.EOF，则   1836年         Tab3.MoveLast   1837          DocNo = Tab3(0)+1   1838       其他   1839年DocNo = 1   1840      如果结束   1841年Tab3.AddNew   1842年Tab3(0)= DocNo   1843年Tab3(1)= DTP1.Value   1844       Tab3(2)= 1   1845年Tab3(3)= IIf(Combo4.ListIndex = 0、1、3)   1846年Tab3(4)= IIf(txtFields(3).Text<>"，txtFields(3).Text，0)   1847年Tab3(5)= IIf(txtFields(1).Text<>"，txtFields(1).Text，0)   1848年Tab3(6)= IIf(txtFields(2).Text<>"，txtFields(2).Text，0)   1849年Tab3(7)= IIf(txtFields(4).Text<>"，txtFields(4).Text，0)   1850       'Tab3(8)="   1851年'Tab3(9)=日期   1852       'Tab3(10)= 0   1853年Tab3(8)= IIf(txtFields(0).Text<>"，txtFields(0).Text，0)   1854年Tab3(9)= TValue   1855   1856年Tab3(10)= 1   1857年Tab3.Update   1858年Tab3.Close   1859年设置Tab3 = Nothing   1860年   1861年设置Tab3 = DB1.OpenRecordset("SELECT * FROM DocNo的Rec_Sub顺序"，dbOpenDynaset)   1862年Tab3.AddNew   1863年Tab3(0)= DocNo   1864年Tab3(1)= DTP1.Value   1865年Tab3(2)= 1   1866年Tab3(3)="   1867年Tab3(4)=日期   1868年Tab3(5)= 0   1869年Tab3(6)= TValue   1870       Tab3(7)=收据不开具发票" & txtFields(0).Text   1871年Tab3(8)= IIf(Combo4.ListIndex = 0、1、3)   1872年Tab3(9)= IIf(txtFields(3).Text<>"，txtFields(3).Text，0)   1873年Tab3(10)= IIf(Combo1.ListIndex> 0，2，1)   1881年Tab3.Update   1882年Tab3.Close   1883年设置Tab3 = Nothing   1884年   1885年如果Combo4.ListIndex = 0，则   1886年设置Tab3 = DB1.OpenRecordset("SELECT * FROM CustTran"，dbOpenDynaset)   1887年Tab3.AddNew   1888         Tab3(0)= DocNo   1889年Tab3(1)= 2   1890          Tab3(2)= DTP1.Value   1891年Tab3(3)= IIf(txtFields(3).Text<>"，txtFields(3).Text，0)   1892年Tab3(4)= TValue   1893年Tab3(5)＝不接收". & DocNo   1894年Tab3.Update   1895年Tab3.Close   1896         设置Tab3 = Nothing   1897年ElseIf Combo4.ListIndex = 1然后   1898年设置Tab3 = DB1.OpenRecordset("SELECT * FROM CustVendTran"，dbOpenDynaset)   1899年Tab3.AddNew   1900          Tab3(0)= DocNo   1901         Tab3(1)= 5   1902          Tab3(2)= DTP1.Value   1903年Tab3(3)= IIf(txtFields(3).Text<>"，txtFields(3).Text，0)   1904年Tab3(4)= TValue   1905年Tab3(5)＝不接收". & DocNo   1906年Tab3.Update   1907年Tab3.Close   1908年设置Tab3 = Nothing   1909年如果结束   1910年设置Tab3 = DB1.OpenRecordset("SELECT * FROM CasherTran"，dbOpenDynaset)   1911年Tab3.AddNew   1912年Tab3(0)= DocNo   1913年Tab3(1)= 3   1914年Tab3(2)= DTP1.Value   1915年Tab3(3)= 0   1916年Tab3(4)= IIf(txtFields(1).Text<>"，txtFields(1).Text，0)   1917年Tab3(5)= IIf(txtFields(2).Text<>"，txtFields(2).Text，0)   1918年Tab3(6)= TValue   1919年Tab3(7)＝不接收". &文档号和"发票编号"& txtFields(0).Text   1920       Tab3.Update   1921年Tab3.Close   1922年设置Tab3 = Nothing   1923年如果结束   1924年   1925年Tab1(0)= IIf(txtFields(0).Text<>"，txtFields(0).Text，0)   1926年Tab1(1)= DTP1.Value   1927年Tab1(2)= Combo1.ListIndex + 1   1928年如果Combo1.ListIndex = 0，则Tab1(3)= 0其他Tab1(3)= Val(txtFields(1).Text)   1929年Tab1(4)= IIf(txtFields(2).Text<>"，txtFields(2).Text，0)   1930年Tab1(5)= IIf(txtFields(3).Text<>"，txtFields(3).Text，0)   1931年Tab1(6)= IIf(txtFields(4).Text<>"，txtFields(4).Text，0)   1932年Tab1(7)= IIf(txtFields(18).Text<>"，txtFields(18).Text，0)   1933年如果txtFields(15).Text =％"，然后Tab1(8)= -1 * Val(txtFields(14).Text)其他Tab1(8)= Val(txtFields(14).Text)   1934年Tab1(9)= IIf(txtFields(17).Text<>"，txtFields(17).Text，0)   1935年Tab1(10)= IIf(txtFields(16).Text<>"，txtFields(16).Text，0)   1936年Tab1(11) = IIf(txtFields(13).Text <> "", txtFields(13).Text, 0)   1937     Tab1(12) = IIf(txtFields(5).Text <> "", txtFields(5).Text, 0)   1938     Tab1(13) = Combo4.ListIndex + 1   1939     Tab1(14) = DocNo   1940     If txtFields(23).Text = "%" Then   1941        Tab1(15) = -1 * Val(IIf(txtFields(22).Text <> "", txtFields(22).Text, 0))   1942     Else   1943        Tab1(15) = IIf(txtFields(22).Text <> "", txtFields(22).Text, 0)   1944     End If   1945     If txtFields(24).Text = "%" Then   1946        Tab1(16) = -1 * Val(IIf(txtFields(25).Text <> "", txtFields(25).Text, 0))   1947     Else   1948        Tab1(16) = IIf(txtFields(25).Text <> "", txtFields(25).Text, 0)   1949     End If   1950     Tab1(17) = IIf(txtFields(26).Text <> "", txtFields(26).Text, 0)   1951     Tab1.Update   1952     Tab1.Close   1953     Set Tab1 = Nothing   1954      1955     Save_Data_Grid   1956      1957     txtFields(0).SetFocus   1958   1959     WorkData.CommitTrans   1960     EMode = False   1961  ExitProc:   1962     Screen.MousePointer = vbDefault   1963     Exit Sub   1964  CancelSesion:   1965     WorkData.Rollback   1966     MsgBox Error(Err) & Chr$(13) & Chr$(LF_Char) & " Process Canceled "   1967     Resume ExitProc   1968  End Sub   ************ this to MAKE Journal    177  Private Sub FillAccDir(ByVal DMode As Byte)    178     Dim Tmp As Recordset    179     Dim TValue As Double    180       181     Select Case DMode    182        Case 1    183           ReDim AccDirArr(1 To 5)    184             185           If Val(txtFields(19).Text) <> 0 Then    186              AccDirArr(1).AccCode = CustAcc    187              AccDirArr(1).DVal = Val(txtFields(19).Text)    188              AccDirArr(1).CVal = 0    189              AccDirArr(1).CostCenter = txtFields(26).Text    190           End If    191             192           If Val(txtFields(17).Text) <> 0 Then    193              Set Tmp = DB1.OpenRecordset("SELECT * FROM AccDir WHERE AccNo = 14", dbOpenSnapshot)    194              If Not Tmp.EOF Then    195                 DiscAcc = Tmp(1)    196              End If    197              Tmp.Close    198              Set Tmp = Nothing    199              AccDirArr(2).AccCode = DiscAcc    200             AccDirArr(2).DVal = Val(txtFields(17).Text)    201              AccDirArr(2).CVal = 0    202              AccDirArr(2).CostCenter = txtFields(26).Text    203           End If    204             205           If Val(txtFields(18).Text) <> 0 Then    206              Set Tmp = DB1.OpenRecordset("SELECT * FROM AccDir WHERE AccNo = " & IIf(Combo1.ListIndex = 1, 21, 1), dbOpenSnapshot)    207              If Not Tmp.EOF Then    208                 SalAcc = Tmp(1)    209              End If    210              Tmp.Close    211              Set Tmp = Nothing    212              AccDirArr(3).AccCode = SalAcc    213              AccDirArr(3).DVal = 0    214              AccDirArr(3).CVal = -Val(txtFields(18).Text)    215              AccDirArr(3).CostCenter = txtFields(26).Text    216           End If    217             218           If Val(txtFields(22).Text) <> 0 Then    219              Set Tmp = DB1.OpenRecordset("SELECT * FROM AccDir WHERE AccNo = 15", dbOpenSnapshot)    220              If Not Tmp.EOF Then    221                 Tax1Acc = Tmp(1)    222              End If    223              Tmp.Close    224              Set Tmp = Nothing    225              AccDirArr(4).AccCode = Tax1Acc    226              AccDirArr(4).DVal = 0    227              AccDirArr(4).CVal = -1 * IIf(txtFields(23) = "%", (Val(txtFields(18).Text) - Val(txtFields(17).Text))/100 * Val(txtFields(22).Text), Val(txtFields(22).Text))    228              AccDirArr(4).CostCenter = txtFields(26).Text    229           End If    230             231           If Val(txtFields(25).Text) <> 0 Then    232              Set Tmp = DB1.OpenRecordset("SELECT * FROM AccDir WHERE AccNo = 16", dbOpenSnapshot)    233              If Not Tmp.EOF Then    234                 Tax2Acc = Tmp(1)    235              End If    236              Tmp.Close    237              Set Tmp = Nothing    238              AccDirArr(5).AccCode = Tax2Acc    239              AccDirArr(5).DVal = 0    240              AccDirArr(5).CVal = -1 * (Val(txtFields(16).Text) + AccDirArr(4).CVal)    241              AccDirArr(5).CostCenter = txtFields(26).Text    242           End If    243        Case 2    244           ReDim AccDirArr(1 To 2)    245             246           If Val(txtFields(18).Text) <> 0 Then    247              Set Tmp = DB1.OpenRecordset("SELECT * FROM AccDir WHERE AccNo = 18", dbOpenSnapshot)    248              If Not Tmp.EOF Then    249                 CStkAcc = Tmp(1)    250              End If    251              Tmp.Close    252              Set Tmp = Nothing    253              AccDirArr(1).AccCode = CStkAcc    254              AccDirArr(1).DVal = ItemCost    255              AccDirArr(1).CVal = 0    256              AccDirArr(1).CostCenter = txtFields(26).Text    257           End If    258             259           If Val(txtFields(18).Text) <> 0 Then    260              Set Tmp = DB1.OpenRecordset("SELECT * FROM AccDir WHERE AccNo = 17", dbOpenSnapshot)    261              If Not Tmp.EOF Then    262                 StkAcc = Tmp(1)    263              End If    264              Tmp.Close    265              Set Tmp = Nothing    266              AccDirArr(2).AccCode = StkAcc    267              AccDirArr(2).DVal = 0    268              AccDirArr(2).CVal = -1 * ItemCost    269              AccDirArr(2).CostCenter = txtFields(26).Text    270           End If    271        Case 3    272           ReDim AccDirArr(1 To 2)    273             274           If Combo1.ListIndex = 1 Then    275              TValue = Val(txtFields(19).Text)    276           ElseIf Combo1.ListIndex = 2 Then    277              TValue = Val(txtFields(13).Text)    278           End If    279             280           If Val(txtFields(19).Text) <> 0 Then    281              AccDirArr(1).AccCode = CustAcc    282              AccDirArr(1).DVal = 0    283              AccDirArr(1).CVal = -TValue    284              AccDirArr(1).CostCenter = txtFields(26).Text    285           End If    286             287           If Val(txtFields(19).Text) <> 0 Then    288              AccDirArr(2).AccCode = CashAcc    289              AccDirArr(2).DVal = TValue    290              AccDirArr(2).CVal = 0    291              AccDirArr(2).CostCenter = txtFields(26).Text    292           End If    293     End Select    294  End Sub   ****************** INSERT GOURNAL TRANS AND UPDATE ACCOUNTS     14  Private Sub DocAddTran(ByVal DMode As Byte)     15     Dim Tab1 As Recordset     16     Dim I As Integer     17        18     Set Tab1 = DB1.OpenRecordset("SELECT * FROM Doc ", dbOpenDynaset)     19     Tab1.AddNew     20     Tab1(0) = DayNo     21     Tab1(1) = DTP1.Value     22     Select Case DMode     23        Case 1     24           Tab1(2) = 1     25           Tab1(3) = "invOice no " & txtFields(0).Text     26        Case 2     27           Tab1(2) = 8     28           Tab1(3) = " invOice no " & txtFields(0).Text     29        Case 3     30           Tab1(2) = 3     31           Tab1(3) = "RECEIVE NO " & DayNo & " invOice no " & txtFields(0).Text     32     End Select     33     Tab1.Update     34     Tab1.Close     35     Set Tab1 = Nothing     36        37     Call FillAccDir(DMode)     38        39     Set Tab1 = DB1.OpenRecordset("SELECT * FROM Doc_Sub ", dbOpenDynaset)     40     For I = 1 To UBound(AccDirArr)     41        If AccDirArr(I).AccCode <> " Then     42           Tab1.AddNew     43           Tab1(0) = DayNo     44           Tab1(1) = DTP1.Value     45           Select Case DMode     46              Case 1     47                 Tab1(2) = 1     48                 Tab1(3) = " invOice no " & txtFields(0).Text     49              Case 2     50                 Tab1(2) = 8     51                 Tab1(3) = " invOice no " & txtFields(0).Text     52              Case 3     53                 Tab1(2) = 3     54                 Tab1(3) = "RECEIVE NO " & DayNo & " invOice no " & txtFields(0).Text     55           End Select     56           Tab1(4) = AccDirArr(I).AccCode     57           Tab1(5) = AccDirArr(I).CostCenter     58           If AccDirArr(I).DVal <> 0 Then     59              Tab1(6) = Val(AccDirArr(I).DVal)     60           Else     61              Tab1(6) = Val(AccDirArr(I).CVal)     62           End If     63           Tab1(7) = False     64           Tab1(8) = True     65           Tab1.Update     66        End If     67     Next I     68     Tab1.Close     69     Set Tab1 = Nothing     70     71     Set Tab1 = DB1.OpenRecordset("Acc", dbOpenDynaset)     72     For I = 1 To UBound(AccDirArr)     73        If AccDirArr(I).AccCode <> " Then     74           Tab1.FindFirst "Code = '" & AccDirArr(I).AccCode & "'"     75           Tab1.Edit     76           If AccDirArr(I).DVal <> 0 Then     77              Tab1("TDVal") = Tab1("TDVal") + Val(AccDirArr(I).DVal)     78           Else     79              Tab1("TCVal") = Tab1("TCVal") + Abs(Val(AccDirArr(I).CVal))     80           End If     81           Tab1("NValue") = Tab1("FValue") + Tab1("TDVal") - Tab1("TCVal")     82           Rank = Trim$(Tab1("ParentAccNo"))     83           Tab1.Update     84           Do Until Trim$(Tab1("ParentAccNo")) = "0"     85              Tab1.FindFirst "Code = '" & Rank & "'"     86              Tab1.Edit     87              If Val(AccDirArr(I).DVal) <> 0 Then     88                 Tab1("TDVal") = Tab1("TDVal") + Val(AccDirArr(I).DVal)     89              Else     90                 Tab1("TCVal") = Tab1("TCVal") + Abs(Val(AccDirArr(I).CVal))     91              End If     92              Tab1("NValue") = Tab1("FValue") + Tab1("TDVal") - Tab1("TCVal")     93              Rank = Trim$(Tab1("ParentAccNo"))     94              Tab1.Update     95           Loop     96        End If     97     Next I     98     Tab1.Close     99     Set Tab1 = Nothing    100       101     Set Tab1 = DB1.OpenRecordset("DocJournal", dbOpenDynaset)    102     Tab1.AddNew    103     Tab1(0) = txtFields(0).Text    104     Tab1(1) = 1    105     Tab1(2) = DayNo    106     Tab1.Update    107     Tab1.Close    108     Set Tab1 = Nothing    109       110  End Sub   解决方案 any one help to REwrite this code on vb2008 and convert connection to sql server exp this function to save sales invoice   1617  Public Sub Save_Data()   1618     Dim Tab1, Tab2, Tab3 As Recordset   1619     Dim Str As String   1620     Dim DocNo As Long   1621     Dim TValue As Double      1629     Set TmpTab = DB1.OpenRecordset("SELECT DocNo FROM Doc ORDER BY DocNo", dbOpenSnapshot)   1630     If Not TmpTab.EOF Then   1631        TmpTab.MoveLast   1632        DayNo = TmpTab(0) + 1   1633     Else   1634        DayNo = 1   1635     End If   1636     TmpTab.Close   1637     Set TmpTab = Nothing   1638      1639     If Not EMode Then Exit Sub   1640      1641     Screen.MousePointer = vbHourglass   1642     On Error GoTo CancelSesion   1643     WorkData.BeginTrans   1644      1645     Set Tab1 = DB1.OpenRecordset("SELECT * FROM " & Trim(TName) & " WHERE DocNo = " & txtFields(0).Text, dbOpenDynaset)   1646     If Tab1.EOF Then   1647        Tab1.AddNew   1648     Else   1649        DB1.Execute "DELETE * FROM SalInv_Sub WHERE DocNo = " & Tab1(0)   1650         1651        Call DocDelTran   1652         1653        If Tab1(13) = 1 Then   1654           Str = "DELETE * FROM CustTran WHERE "   1655           Str = Str & "DocNo = " & Tab1(0)   1656           Str = Str & " AND DocType = 1"   1657           Str = Str & " AND CustCode = " & Tab1(5)   1658           DB1.Execute Str   1659        ElseIf Tab1(13) = 2 Then   1660           Str = "DELETE * FROM CustVendTran WHERE "   1661           Str = Str & "DocNo = " & Tab1(0)   1662           Str = Str & " AND DocType = 1"   1663           Str = Str & " AND CustCode = " & Tab1(5)   1664           DB1.Execute Str   1665        End If   1666         1667        Str = "DELETE * FROM ItemTran WHERE "   1668        Str = Str & "DocNo = " & Tab1(0)   1669        Str = Str & " AND DocType = 4"   1670        DB1.Execute Str   1671               1672        If Tab1(13) = 1 Then   1673           If Tab1(2) = 1 Or Tab1(2) = 3 Then   1674              TValue = Tab1(7) - Tab1(9) + Tab1(10) - Tab1(11)   1675              Set Tab2 = DB1.OpenRecordset("SELECT TValue FROM Customer WHERE Code = " & Tab1(5), dbOpenDynaset)   1676              If Not Tab2.EOF Then   1677                 Tab2.MoveFirst   1678                 Tab2.Edit   1679                 Tab2(0) = Tab2(0) - TValue   1680                 Tab2.Update   1681              End If   1682              Tab2.Close   1683              Set Tab2 = Nothing   1684           End If   1685        ElseIf Tab1(13) = 2 Then   1686           If Tab1(2) = 1 Or Tab1(2) = 3 Then   1687              TValue = Tab1(7) - Tab1(9) + Tab1(10) - Tab1(11)   1688              Set Tab2 = DB1.OpenRecordset("SELECT TValue FROM CustVend WHERE Code = " & Tab1(5), dbOpenDynaset)   1689              If Not Tab2.EOF Then   1690                 Tab2.MoveFirst   1691                 Tab2.Edit   1692                 Tab2(0) = Tab2(0) - TValue   1693                 Tab2.Update   1694              End If   1695              Tab2.Close   1696              Set Tab2 = Nothing   1697           End If   1698        End If   1699         1700        If Tab1(2) > 1 Then   1701           Str = "SELECT * FROM Recieve WHERE "   1702           Str = Str & "DocNo = " & Tab1(14)   1703           Str = Str & " AND CACode = " & Tab1(5)   1704           Str = Str & " AND InvNo = " & Tab1(0)   1705           Set Tab2 = DB1.OpenRecordset(Str, dbOpenDynaset)   1706           If Not Tab2.EOF Then   1707              If Tab1(13) = 1 Then   1708                 Str = "DELETE * FROM CustTran WHERE "   1709                 Str = Str & "DocNo = " & Tab2(0)   1710                 Str = Str & " AND DocType = 2"   1711                 Str = Str & " AND CustCode = " & Tab2(4)   1712                 DB1.Execute Str   1713              ElseIf Tab1(13) = 2 Then   1714                 Str = "DELETE * FROM CustVendTran WHERE "   1715                 Str = Str & "DocNo = " & Tab2(0)   1716                 Str = Str & " AND DocType = 5"   1717                 Str = Str & " AND CustCode = " & Tab2(4)   1718                 DB1.Execute Str   1719              End If   1720               1721              Str = "DELETE * FROM CasherTran WHERE "   1722              Str = Str & "DocNo = " & Tab2(0)   1723              Str = Str & " AND DocType = 3"   1724              Str = Str & " AND ExpCode = 0"   1725              Str = Str & " AND CasherCode = " & Tab2(5)   1726              DB1.Execute Str   1727            1728              Str = "DELETE * FROM Rec_Sub WHERE "   1729              Str = Str & "DocNo = " & Tab2(0)   1730              DB1.Execute Str   1731            1732           End If   1733           Tab2.Close   1734           Set Tab2 = Nothing   1735            1736           Str = "DELETE * FROM Recieve WHERE "   1737           Str = Str & "DocNo = " & Tab1(14)   1738           Str = Str & " AND CACode = " & Tab1(5)   1739           Str = Str & " AND InvNo = " & Tab1(0)   1740           Str = Str & " AND DocCase = 1"   1741           DB1.Execute Str   1742               1743        End If   1744        Tab1.Edit   1745     End If   1746         1747     Call DocAddTran(1)   1748   1749     Set TmpTab = DB1.OpenRecordset("SELECT DocNo FROM Doc ORDER BY DocNo", dbOpenSnapshot)   1750     If Not TmpTab.EOF Then   1751        TmpTab.MoveLast   1752        DayNo = TmpTab(0) + 1   1753     Else   1754        DayNo = 1   1755     End If   1756     TmpTab.Close   1757     Set TmpTab = Nothing   1758   1759     Call DocAddTran(2)   1760   1761     If Combo1.ListIndex = 1 Or Combo1.ListIndex = 2 Then   1762        Set TmpTab = DB1.OpenRecordset("SELECT DocNo FROM Doc ORDER BY DocNo", dbOpenSnapshot)   1763        If Not TmpTab.EOF Then   1764           TmpTab.MoveLast   1765           DayNo = TmpTab(0) + 1   1766        Else   1767           DayNo = 1   1768        End If   1769        TmpTab.Close   1770        Set TmpTab = Nothing   1771        Call DocAddTran(3)   1772     End If   1773      1774     If Combo4.ListIndex = 0 Then   1775        Set Tab3 = DB1.OpenRecordset("SELECT * FROM CustTran ", dbOpenDynaset)   1776        Tab3.AddNew   1777        Tab3(0) = IIf(txtFields(0).Text <> "", txtFields(0).Text, 0)   1778        Tab3(1) = 1   1779        Tab3(2) = DTP1.Value   1780        Tab3(3) = IIf(txtFields(3).Text <> "", txtFields(3).Text, 0)   1781        Tab3(4) = IIf(txtFields(19).Text <> "", txtFields(19).Text, 0)   1782        Tab3(5) = " invoice no " & txtFields(0).Text   1783        Tab3.Update   1784        Tab3.Close   1785        Set Tab3 = Nothing   1786     ElseIf Combo4.ListIndex = 1 Then   1787        Set Tab3 = DB1.OpenRecordset("SELECT * FROM CustVendTran ", dbOpenDynaset)   1788        Tab3.AddNew   1789        Tab3(0) = IIf(txtFields(0).Text <> "", txtFields(0).Text, 0)   1790        Tab3(1) = 1   1791        Tab3(2) = DTP1.Value   1792        Tab3(3) = IIf(txtFields(3).Text <> "", txtFields(3).Text, 0)   1793        Tab3(4) = IIf(txtFields(19).Text <> "", txtFields(19).Text, 0)   1794        Tab3(5) = "invoice no" & txtFields(0).Text   1795        Tab3.Update   1796        Tab3.Close   1797        Set Tab3 = Nothing   1798     End If   1799      1800     If Combo4.ListIndex = 0 Then   1801        If Combo1.ListIndex = 0 Or Combo1.ListIndex = 2 Then   1802           TValue = Val(txtFields(19).Text) - Val(txtFields(13).Text)   1803           Set Tab3 = DB1.OpenRecordset("SELECT TValue FROM Customer WHERE Code = " & txtFields(3).Text, dbOpenDynaset)   1804           If Not Tab3.EOF Then   1805              Tab3.MoveFirst   1806              Tab3.Edit   1807              Tab3(0) = Tab3(0) + TValue   1808              Tab3.Update   1809           End If   1810           Tab3.Close   1811           Set Tab3 = Nothing   1812        End If   1813     ElseIf Combo4.ListIndex = 1 Then   1814        If Combo1.ListIndex = 0 Or Combo1.ListIndex = 2 Then   1815           TValue = Val(txtFields(19).Text) - Val(txtFields(13).Text)   1816           Set Tab3 = DB1.OpenRecordset("SELECT TValue FROM CustVend WHERE Code = " & txtFields(3).Text, dbOpenDynaset)   1817           If Not Tab3.EOF Then   1818              Tab3.MoveFirst   1819              Tab3.Edit   1820              Tab3(0) = Tab3(0) + TValue   1821              Tab3.Update   1822           End If   1823           Tab3.Close   1824           Set Tab3 = Nothing   1825        End If   1826     End If   1827      1828     If Combo1.ListIndex = 1 Then   1829        TValue = Val(txtFields(19).Text)   1830     ElseIf Combo1.ListIndex = 2 Then   1831        TValue = Val(txtFields(13).Text)   1832     End If   1833     If Combo1.ListIndex > 0 Then   1834        Set Tab3 = DB1.OpenRecordset("SELECT * FROM Recieve order by DocNo", dbOpenDynaset)   1835        If Not Tab3.EOF Then   1836           Tab3.MoveLast   1837           DocNo = Tab3(0) + 1   1838        Else   1839           DocNo = 1   1840        End If   1841        Tab3.AddNew   1842        Tab3(0) = DocNo   1843        Tab3(1) = DTP1.Value   1844        Tab3(2) = 1   1845        Tab3(3) = IIf(Combo4.ListIndex = 0, 1, 3)   1846        Tab3(4) = IIf(txtFields(3).Text <> "", txtFields(3).Text, 0)   1847        Tab3(5) = IIf(txtFields(1).Text <> "", txtFields(1).Text, 0)   1848        Tab3(6) = IIf(txtFields(2).Text <> "", txtFields(2).Text, 0)   1849        Tab3(7) = IIf(txtFields(4).Text <> "", txtFields(4).Text, 0)   1850        'Tab3(8) = ""   1851        'Tab3(9) = Date   1852        'Tab3(10) = 0   1853        Tab3(8) = IIf(txtFields(0).Text <> "", txtFields(0).Text, 0)   1854        Tab3(9) = TValue   1855   1856        Tab3(10) = 1   1857        Tab3.Update   1858        Tab3.Close   1859        Set Tab3 = Nothing   1860         1861        Set Tab3 = DB1.OpenRecordset("SELECT * FROM Rec_Sub order by DocNo", dbOpenDynaset)   1862        Tab3.AddNew   1863        Tab3(0) = DocNo   1864        Tab3(1) = DTP1.Value   1865        Tab3(2) = 1   1866        Tab3(3) = ""   1867        Tab3(4) = Date   1868        Tab3(5) = 0   1869        Tab3(6) = TValue   1870        Tab3(7) = "recive no to invoice no " & txtFields(0).Text   1871        Tab3(8) = IIf(Combo4.ListIndex = 0, 1, 3)   1872        Tab3(9) = IIf(txtFields(3).Text <> "", txtFields(3).Text, 0)   1873        Tab3(10) = IIf(Combo1.ListIndex > 0, 2, 1)   1881        Tab3.Update   1882        Tab3.Close   1883        Set Tab3 = Nothing   1884         1885        If Combo4.ListIndex = 0 Then   1886           Set Tab3 = DB1.OpenRecordset("SELECT * FROM CustTran ", dbOpenDynaset)   1887           Tab3.AddNew   1888           Tab3(0) = DocNo   1889           Tab3(1) = 2   1890           Tab3(2) = DTP1.Value   1891           Tab3(3) = IIf(txtFields(3).Text <> "", txtFields(3).Text, 0)   1892           Tab3(4) = TValue   1893           Tab3(5) = "receive no" & DocNo   1894           Tab3.Update   1895           Tab3.Close   1896           Set Tab3 = Nothing   1897        ElseIf Combo4.ListIndex = 1 Then   1898           Set Tab3 = DB1.OpenRecordset("SELECT * FROM CustVendTran ", dbOpenDynaset)   1899           Tab3.AddNew   1900           Tab3(0) = DocNo   1901           Tab3(1) = 5   1902           Tab3(2) = DTP1.Value   1903           Tab3(3) = IIf(txtFields(3).Text <> "", txtFields(3).Text, 0)   1904           Tab3(4) = TValue   1905           Tab3(5) = "receive no" & DocNo   1906           Tab3.Update   1907           Tab3.Close   1908           Set Tab3 = Nothing   1909        End If   1910        Set Tab3 = DB1.OpenRecordset("SELECT * FROM CasherTran ", dbOpenDynaset)   1911        Tab3.AddNew   1912        Tab3(0) = DocNo   1913        Tab3(1) = 3   1914        Tab3(2) = DTP1.Value   1915        Tab3(3) = 0   1916        Tab3(4) = IIf(txtFields(1).Text <> "", txtFields(1).Text, 0)   1917        Tab3(5) = IIf(txtFields(2).Text <> "", txtFields(2).Text, 0)   1918        Tab3(6) = TValue   1919        Tab3(7) = "receive no" & DocNo & " invoice no" & txtFields(0).Text   1920        Tab3.Update   1921        Tab3.Close   1922        Set Tab3 = Nothing   1923     End If   1924      1925     Tab1(0) = IIf(txtFields(0).Text <> "", txtFields(0).Text, 0)   1926     Tab1(1) = DTP1.Value   1927     Tab1(2) = Combo1.ListIndex + 1   1928     If Combo1.ListIndex = 0 Then Tab1(3) = 0 Else Tab1(3) = Val(txtFields(1).Text)   1929     Tab1(4) = IIf(txtFields(2).Text <> "", txtFields(2).Text, 0)   1930     Tab1(5) = IIf(txtFields(3).Text <> "", txtFields(3).Text, 0)   1931     Tab1(6) = IIf(txtFields(4).Text <> "", txtFields(4).Text, 0)   1932     Tab1(7) = IIf(txtFields(18).Text <> "", txtFields(18).Text, 0)   1933     If txtFields(15).Text = "%" Then Tab1(8) = -1 * Val(txtFields(14).Text) Else Tab1(8) = Val(txtFields(14).Text)   1934     Tab1(9) = IIf(txtFields(17).Text <> "", txtFields(17).Text, 0)   1935     Tab1(10) = IIf(txtFields(16).Text <> "", txtFields(16).Text, 0)   1936     Tab1(11) = IIf(txtFields(13).Text <> "", txtFields(13).Text, 0)   1937     Tab1(12) = IIf(txtFields(5).Text <> "", txtFields(5).Text, 0)   1938     Tab1(13) = Combo4.ListIndex + 1   1939     Tab1(14) = DocNo   1940     If txtFields(23).Text = "%" Then   1941        Tab1(15) = -1 * Val(IIf(txtFields(22).Text <> "", txtFields(22).Text, 0))   1942     Else   1943        Tab1(15) = IIf(txtFields(22).Text <> "", txtFields(22).Text, 0)   1944     End If   1945     If txtFields(24).Text = "%" Then   1946        Tab1(16) = -1 * Val(IIf(txtFields(25).Text <> "", txtFields(25).Text, 0))   1947     Else   1948        Tab1(16) = IIf(txtFields(25).Text <> "", txtFields(25).Text, 0)   1949     End If   1950     Tab1(17) = IIf(txtFields(26).Text <> "", txtFields(26).Text, 0)   1951     Tab1.Update   1952     Tab1.Close   1953     Set Tab1 = Nothing   1954      1955     Save_Data_Grid   1956      1957     txtFields(0).SetFocus   1958   1959     WorkData.CommitTrans   1960     EMode = False   1961  ExitProc:   1962     Screen.MousePointer = vbDefault   1963     Exit Sub   1964  CancelSesion:   1965     WorkData.Rollback   1966     MsgBox Error(Err) & Chr$(13) & Chr$(LF_Char) & " Process Canceled "   1967     Resume ExitProc   1968  End Sub   ************ this to MAKE Journal    177  Private Sub FillAccDir(ByVal DMode As Byte)    178     Dim Tmp As Recordset    179     Dim TValue As Double    180       181     Select Case DMode    182        Case 1    183           ReDim AccDirArr(1 To 5)    184             185           If Val(txtFields(19).Text) <> 0 Then    186              AccDirArr(1).AccCode = CustAcc    187              AccDirArr(1).DVal = Val(txtFields(19).Text)    188              AccDirArr(1).CVal = 0    189              AccDirArr(1).CostCenter = txtFields(26).Text    190           End If    191             192           If Val(txtFields(17).Text) <> 0 Then    193              Set Tmp = DB1.OpenRecordset("SELECT * FROM AccDir WHERE AccNo = 14", dbOpenSnapshot)    194              If Not Tmp.EOF Then    195                 DiscAcc = Tmp(1)    196              End If    197              Tmp.Close    198              Set Tmp = Nothing    199              AccDirArr(2).AccCode = DiscAcc    200              AccDirArr(2).DVal = Val(txtFields(17).Text)    201              AccDirArr(2).CVal = 0    202              AccDirArr(2).CostCenter = txtFields(26).Text    203           End If    204             205           If Val(txtFields(18).Text) <> 0 Then    206              Set Tmp = DB1.OpenRecordset("SELECT * FROM AccDir WHERE AccNo = " & IIf(Combo1.ListIndex = 1, 21, 1), dbOpenSnapshot)    207              If Not Tmp.EOF Then    208                 SalAcc = Tmp(1)    209              End If    210              Tmp.Close    211              Set Tmp = Nothing    212              AccDirArr(3).AccCode = SalAcc    213              AccDirArr(3).DVal = 0    214              AccDirArr(3).CVal = -Val(txtFields(18).Text)    215              AccDirArr(3).CostCenter = txtFields(26).Text    216           End If    217             218           If Val(txtFields(22).Text) <> 0 Then    219              Set Tmp = DB1.OpenRecordset("SELECT * FROM AccDir WHERE AccNo = 15", dbOpenSnapshot)    220              If Not Tmp.EOF Then    221                 Tax1Acc = Tmp(1)    222              End If    223              Tmp.Close    224              Set Tmp = Nothing    225              AccDirArr(4).AccCode = Tax1Acc    226              AccDirArr(4).DVal = 0    227              AccDirArr(4).CVal = -1 * IIf(txtFields(23) = "%", (Val(txtFields(18).Text) - Val(txtFields(17).Text)) / 100 * Val(txtFields(22).Text), Val(txtFields(22).Text))    228              AccDirArr(4).CostCenter = txtFields(26).Text    229           End If    230             231           If Val(txtFields(25).Text) <> 0 Then    232              Set Tmp = DB1.OpenRecordset("SELECT * FROM AccDir WHERE AccNo = 16", dbOpenSnapshot)    233              If Not Tmp.EOF Then    234                 Tax2Acc = Tmp(1)    235              End If    236              Tmp.Close    237              Set Tmp = Nothing    238              AccDirArr(5).AccCode = Tax2Acc    239              AccDirArr(5).DVal = 0    240              AccDirArr(5).CVal = -1 * (Val(txtFields(16).Text) + AccDirArr(4).CVal)    241              AccDirArr(5).CostCenter = txtFields(26).Text    242           End If    243        Case 2    244           ReDim AccDirArr(1 To 2)    245             246           If Val(txtFields(18).Text) <> 0 Then    247              Set Tmp = DB1.OpenRecordset("SELECT * FROM AccDir WHERE AccNo = 18", dbOpenSnapshot)    248              If Not Tmp.EOF Then    249                 CStkAcc = Tmp(1)    250              End If    251              Tmp.Close    252              Set Tmp = Nothing    253              AccDirArr(1).AccCode = CStkAcc    254              AccDirArr(1).DVal = ItemCost    255              AccDirArr(1).CVal = 0    256              AccDirArr(1).CostCenter = txtFields(26).Text    257           End If    258             259           If Val(txtFields(18).Text) <> 0 Then    260              Set Tmp = DB1.OpenRecordset("SELECT * FROM AccDir WHERE AccNo = 17", dbOpenSnapshot)    261              If Not Tmp.EOF Then    262                 StkAcc = Tmp(1)    263              End If    264              Tmp.Close    265              Set Tmp = Nothing    266              AccDirArr(2).AccCode = StkAcc    267              AccDirArr(2).DVal = 0    268              AccDirArr(2).CVal = -1 * ItemCost    269              AccDirArr(2).CostCenter = txtFields(26).Text    270           End If    271        Case 3    272           ReDim AccDirArr(1 To 2)    273             274           If Combo1.ListIndex = 1 Then    275              TValue = Val(txtFields(19).Text)    276           ElseIf Combo1.ListIndex = 2 Then    277              TValue = Val(txtFields(13).Text)    278           End If    279             280           If Val(txtFields(19).Text) <> 0 Then    281              AccDirArr(1).AccCode = CustAcc    282              AccDirArr(1).DVal = 0    283              AccDirArr(1).CVal = -TValue    284              AccDirArr(1).CostCenter = txtFields(26).Text    285           End If    286             287           If Val(txtFields(19).Text) <> 0 Then    288              AccDirArr(2).AccCode = CashAcc    289              AccDirArr(2).DVal = TValue    290              AccDirArr(2).CVal = 0    291              AccDirArr(2).CostCenter = txtFields(26).Text    292           End If    293     End Select    294  End Sub   ****************** INSERT GOURNAL TRANS AND UPDATE ACCOUNTS     14  Private Sub DocAddTran(ByVal DMode As Byte)     15     Dim Tab1 As Recordset     16     Dim I As Integer     17        18     Set Tab1 = DB1.OpenRecordset("SELECT * FROM Doc ", dbOpenDynaset)     19     Tab1.AddNew     20     Tab1(0) = DayNo     21     Tab1(1) = DTP1.Value     22     Select Case DMode     23        Case 1     24           Tab1(2) = 1     25           Tab1(3) = "invOice no " & txtFields(0).Text     26        Case 2     27           Tab1(2) = 8     28           Tab1(3) = " invOice no " & txtFields(0).Text     29        Case 3     30           Tab1(2) = 3     31           Tab1(3) = "RECEIVE NO " & DayNo & " invOice no " & txtFields(0).Text     32     End Select     33     Tab1.Update     34     Tab1.Close     35     Set Tab1 = Nothing     36        37     Call FillAccDir(DMode)     38        39     Set Tab1 = DB1.OpenRecordset("SELECT * FROM Doc_Sub ", dbOpenDynaset)     40     For I = 1 To UBound(AccDirArr)     41        If AccDirArr(I).AccCode <> "" Then     42           Tab1.AddNew     43           Tab1(0) = DayNo     44           Tab1(1) = DTP1.Value     45           Select Case DMode     46              Case 1     47                 Tab1(2) = 1     48                 Tab1(3) = " invOice no " & txtFields(0).Text     49              Case 2     50                 Tab1(2) = 8     51                 Tab1(3) = " invOice no " & txtFields(0).Text     52              Case 3     53                 Tab1(2) = 3     54                 Tab1(3) = "RECEIVE NO " & DayNo & " invOice no " & txtFields(0).Text     55           End Select     56           Tab1(4) = AccDirArr(I).AccCode     57           Tab1(5) = AccDirArr(I).CostCenter     58           If AccDirArr(I).DVal <> 0 Then     59              Tab1(6) = Val(AccDirArr(I).DVal)     60           Else     61              Tab1(6) = Val(AccDirArr(I).CVal)     62           End If     63           Tab1(7) = False     64           Tab1(8) = True     65           Tab1.Update     66        End If     67     Next I     68     Tab1.Close     69     Set Tab1 = Nothing     70     71     Set Tab1 = DB1.OpenRecordset("Acc", dbOpenDynaset)     72     For I = 1 To UBound(AccDirArr)     73        If AccDirArr(I).AccCode <> "" Then     74           Tab1.FindFirst "Code = '" & AccDirArr(I).AccCode & "'"     75           Tab1.Edit     76           If AccDirArr(I).DVal <> 0 Then     77              Tab1("TDVal") = Tab1("TDVal") + Val(AccDirArr(I).DVal)     78           Else     79              Tab1("TCVal") = Tab1("TCVal") + Abs(Val(AccDirArr(I).CVal))     80           End If     81           Tab1("NValue") = Tab1("FValue") + Tab1("TDVal") - Tab1("TCVal")     82           Rank = Trim$(Tab1("ParentAccNo"))     83           Tab1.Update     84           Do Until Trim$(Tab1("ParentAccNo")) = "0"     85              Tab1.FindFirst "Code = '" & Rank & "'"     86              Tab1.Edit     87              If Val(AccDirArr(I).DVal) <> 0 Then     88                 Tab1("TDVal") = Tab1("TDVal") + Val(AccDirArr(I).DVal)     89              Else     90                 Tab1("TCVal") = Tab1("TCVal") + Abs(Val(AccDirArr(I).CVal))     91              End If     92              Tab1("NValue") = Tab1("FValue") + Tab1("TDVal") - Tab1("TCVal")     93              Rank = Trim$(Tab1("ParentAccNo"))     94              Tab1.Update     95           Loop     96        End If     97     Next I     98     Tab1.Close     99     Set Tab1 = Nothing    100       101     Set Tab1 = DB1.OpenRecordset("DocJournal", dbOpenDynaset)    102     Tab1.AddNew    103     Tab1(0) = txtFields(0).Text    104     Tab1(1) = 1    105     Tab1(2) = DayNo    106     Tab1.Update    107     Tab1.Close    108     Set Tab1 = Nothing    109       110  End Sub   解决方案 这篇关于VB6到VB2008_DAO_TO_ADO SQL SEVER的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！ 上岸，阿里云！
08-16 05:11
Powered by LMLPHP ©2024 VB6到VB2008 0.038028