|
本帖最后由 鱼儿游游 于 2012-9-5 20:43 编辑
是这样的效果吗?- Option Compare Database
- Option Explicit
- Private Sub cmddr_Click()
- Dim strRelated As String
- Dim strUpdate As String
- strRelated = "管理卡号=管理卡号,品号=品号,外协单位=外协单位,生产任务=生产任务" '表关联字段列表:目标表的字段=源表的字段
- strUpdate = "小组=小组,来图日期=来图日期,实际完工日期=实际完工日期" '表更新字段列表:目标表的字段=源表的字段
- Call ImportFromTable("tblhj", "tbldd", strRelated, strUpdate)
- End Sub
- '
- ' 导入数据
- '
- Private Function ImportFromTable(strObjectTableName As String, strSourceTableName As String, ByVal strRelated, ByVal strUpdate) As Boolean
- On Error GoTo Err_Handler
- Dim blnResult As Boolean
- Dim rstSource As Object
- Dim rstObject As Object
- Dim arrRelated As Variant
- Dim arrUpdate As Variant
- Dim arrTemp As Variant
- Dim strSQL As String
- Dim strWhere As String
- Dim lngCounter As Long
- Dim intI As Integer
-
- '初始化:返回值
- blnResult = False
-
- '定义ADO记录集
- Set rstSource = CreateObject("ADODB.Recordset")
- Set rstObject = CreateObject("ADODB.Recordset")
-
- '表关联字段列表:目标表的字段=源表的字段
- arrRelated = Split(strRelated, ",")
-
- '表更新字段列表:目标表的字段=源表的字段
- arrUpdate = Split(strUpdate, ",")
-
- '打开源数据库的数据表
- strSQL = "SELECT * FROM [" & strSourceTableName & "]"
- rstSource.Open strSQL, CurrentProject.AccessConnection, 1, 1
- If rstSource.RecordCount > 0 Then rstSource.MoveFirst
- lngCounter = 0
-
- '遍历源表所有记录
- Do While Not rstSource.EOF
- strWhere = ""
- For intI = LBound(arrRelated) To UBound(arrRelated)
- arrTemp = Split(arrRelated(intI), "=")
- strWhere = strWhere & Trim(arrTemp(0)) & "='" & rstSource.Fields(Trim(arrTemp(1))) & "'" '目标表的字段=源表的字段的值
- strWhere = strWhere & " AND "
- Next
- strWhere = Left(strWhere, Len(strWhere) - 5)
- '打开目标表,并判断是否存在指定条件的记录
- strSQL = "SELECT * FROM [" & strObjectTableName & "] WHERE " & strWhere
- rstObject.Open strSQL, CurrentProject.AccessConnection, 1, 3
- If rstObject.RecordCount > 0 Then
- '存在则:用源表中的有字段更新目标表中的有关字段
- rstObject.MoveFirst
- For intI = LBound(arrUpdate) To UBound(arrUpdate)
- arrTemp = Split(arrUpdate(intI), "=")
- rstObject.Fields(Trim(arrTemp(0))) = rstSource.Fields(Trim(arrTemp(1)))
- Next
- lngCounter = lngCounter + 1
- rstObject.Update
- End If
- rstObject.Close
- '源表下一条记录
- rstSource.MoveNext
- Loop
- rstSource.Close
-
- If lngCounter > 0 Then MsgBox "共导入" & CStr(lngCounter) & " 笔记录", vbExclamation, "导入结果"
-
- '返回值
- blnResult = True
- Exit_Handler:
- '返回值
- ImportFromTable = blnResult
- '释放变量
- Set rstSource = Nothing
- Set rstObject = Nothing
- '退出本函数
- Exit Function
- Err_Handler:
- blnResult = False
- MsgBox Err.Description, vbExclamation, "导入出错"
- Resume Exit_Handler
- End Function
复制代码 |
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|