导入请教

鱼儿游游

会计表和调度表 共同的字段是哪些？ 要导入的字段有哪些？

鱼儿游游

是这样的效果吗？

1. Option Compare Database
   
2. Option Explicit
   
3. 
   
4. Private Sub cmddr_Click()
   
5.     Dim strRelated As String
   
6.     Dim strUpdate As String
   
7.     strRelated = "管理卡号=管理卡号,品号=品号,外协单位=外协单位,生产任务=生产任务"   '表关联字段列表：目标表的字段=源表的字段
   
8.     strUpdate = "小组=小组,来图日期=来图日期,实际完工日期=实际完工日期"              '表更新字段列表：目标表的字段=源表的字段
   
9.     Call ImportFromTable("tblhj", "tbldd", strRelated, strUpdate)
   
10. End Sub
    
11. '
    
12. ' 导入数据
    
13. '
    
14. Private Function ImportFromTable(strObjectTableName As String, strSourceTableName As String, ByVal strRelated, ByVal strUpdate) As Boolean
    
15. On Error GoTo Err_Handler
    
16. 
    
17.     Dim blnResult  As Boolean
    
18.     Dim rstSource  As Object
    
19.     Dim rstObject  As Object
    
20.     Dim arrRelated As Variant
    
21.     Dim arrUpdate  As Variant
    
22.     Dim arrTemp    As Variant
    
23.     Dim strSQL     As String
    
24.     Dim strWhere   As String
    
25.     Dim lngCounter As Long
    
26.     Dim intI       As Integer
    
27.    
    
28.     '初始化：返回值
    
29.     blnResult = False
    
30.    
    
31.     '定义ADO记录集
    
32.     Set rstSource = CreateObject("ADODB.Recordset")
    
33.     Set rstObject = CreateObject("ADODB.Recordset")
    
34.    
    
35.     '表关联字段列表：目标表的字段=源表的字段
    
36.     arrRelated = Split(strRelated, ",")
    
37.    
    
38.     '表更新字段列表：目标表的字段=源表的字段
    
39.     arrUpdate = Split(strUpdate, ",")
    
40.       
    
41.     '打开源数据库的数据表
    
42.     strSQL = "SELECT * FROM [" & strSourceTableName & "]"
    
43.     rstSource.Open strSQL, CurrentProject.AccessConnection, 1, 1
    
44.     If rstSource.RecordCount > 0 Then rstSource.MoveFirst
    
45.     lngCounter = 0
    
46.    
    
47.     '遍历源表所有记录
    
48.     Do While Not rstSource.EOF
    
49.        strWhere = ""
    
50.        For intI = LBound(arrRelated) To UBound(arrRelated)
    
51.           arrTemp = Split(arrRelated(intI), "=")
    
52.           strWhere = strWhere & Trim(arrTemp(0)) & "='" & rstSource.Fields(Trim(arrTemp(1))) & "'"   '目标表的字段=源表的字段的值
    
53.           strWhere = strWhere & " AND "
    
54.        Next
    
55.        strWhere = Left(strWhere, Len(strWhere) - 5)
    
56.        '打开目标表，并判断是否存在指定条件的记录
    
57.        strSQL = "SELECT * FROM [" & strObjectTableName & "] WHERE " & strWhere
    
58.        rstObject.Open strSQL, CurrentProject.AccessConnection, 1, 3
    
59.        If rstObject.RecordCount > 0 Then
    
60.           '存在则：用源表中的有字段更新目标表中的有关字段
    
61.           rstObject.MoveFirst
    
62.           For intI = LBound(arrUpdate) To UBound(arrUpdate)
    
63.              arrTemp = Split(arrUpdate(intI), "=")
    
64.              rstObject.Fields(Trim(arrTemp(0))) = rstSource.Fields(Trim(arrTemp(1)))
    
65.           Next
    
66.           lngCounter = lngCounter + 1
    
67.           rstObject.Update
    
68.        End If
    
69.        rstObject.Close
    
70.        '源表下一条记录
    
71.        rstSource.MoveNext
    
72.     Loop
    
73.     rstSource.Close
    
74.    
    
75.     If lngCounter > 0 Then MsgBox "共导入" & CStr(lngCounter) & " 笔记录", vbExclamation, "导入结果"
    
76.    
    
77.     '返回值
    
78.     blnResult = True
    
79. 
    
80. Exit_Handler:
    
81.     '返回值
    
82.     ImportFromTable = blnResult
    
83.     '释放变量
    
84.     Set rstSource = Nothing
    
85.     Set rstObject = Nothing
    
86.     '退出本函数
    
87.     Exit Function
    
88. Err_Handler:
    
89.     blnResult = False
    
90.     MsgBox Err.Description, vbExclamation, "导入出错"
    
91.     Resume Exit_Handler
    
92. End Function
    

复制代码