VB6到VB2008_DAO_TO_ADO SQL SEVER [英] VB6 TO VB2008_DAO_TO_ADO SQL SEVER
问题描述
任何人都可以在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
Hello ,
感谢您的发帖！ I would suggest posting your question in the Visual Basic located here: http://social.msdn.microsoft.com/Forums/en-US/category/visualbasic
祝您度过愉快的一天！
谢谢！
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
Hello ,
Thank you for your post! I would suggest posting your question in the Visual Basic located here: http://social.msdn.microsoft.com/Forums/en-US/category/visualbasic
Have a great day!
Thanks!
这篇关于VB6到VB2008_DAO_TO_ADO SQL SEVER的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
