兄弟们呀,帮帮我吧！（原代码,SQL SERVER）

[白掌柜]

'''兄弟们呀,帮帮我吧！
'''
'''在服务器上动行时提示value 的field 方法失败。
'''
'''
Option Explicit
Dim Conn As New ADODB.Connection 'SQL SERVER 的连接
Dim RsTabList As New ADODB.Recordset '要改动的表名列表

Dim RsDeptOldNew As New ADODB.Recordset '新旧部门对照表
Dim RsOldTab As New ADODB.Recordset '要被改动的旧表

'Dim CmUpdate As New ADODB.Command '调用更改存贮过程

Dim strTabName As String '要发生变动的表名
Dim strFieldName As String '表中要改变的字段名
Dim strOldDeptCode As String '旧的部门编号
Dim strNewDeptCode As String '新的部门编号

Dim strSQL As String
---------------------------------------------------------------
Private Sub Command1_Click()

With Conn '打开连接
.Provider = "SQLOLEDB"
.CursorLocation = adUseServer
.Properties("Data Source") = "love"
.Properties("Initial Catalog") = "Test"
.Properties("User Id") = "sa"
.Properties("Password") = ""
.Properties("prompt") = adPromptNever
.Open
DoEvents
End With

' With CmUpdate
' .ActiveConnection = Conn
'
' End With
With RsTabList '打开要改动的表名列表
.ActiveConnection = Conn
.Source = "select * from bsjTab"
.Open
End With

With StepMain
'RsTabList.MoveLast
'RsTabList.MoveFirst
.Value = 0
.Max = 19 'RsTabList.RecordCount
.Min = 0
End With
Do Until RsTabList.EOF '循环开始

strTabName = Trim(RsTabList!tabName) '取表名
strFieldName = Trim(RsTabList!myField) '取字段名
Label1.Caption = "正在更改“" & strTabName & "”表……"
strSQL = "select * from " & strTabName

With RsOldTab
.ActiveConnection = Conn
.CursorLocation = adUseServer
.Source = strSQL
.Open '打开要被改动的旧表
End With
If (Not RsOldTab.EOF) And (Not RsOldTab.BOF) Then
With Step
'RsOldTab.MoveLast
'RsOldTab.MoveFirst
.Value = 0
.Max = 1000 'RsOldTab.RecordCount
.Min = 0
End With
End If
Do Until RsOldTab.EOF '循环开始
'取得旧部门编号
strOldDeptCode = Trim(RsOldTab.Fields(strFieldName).Value)
'取得新部门编号
strNewDeptCode = Trim(GetNewDeptCode(strOldDeptCode))
'更改部门编号
RsOldTab.Fields(strFieldName).Value = strNewDeptCode
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'提示value 的field 方法失败



Stop
'strSQL = "update " & strTabName & " set " & strFieldName & "='" & strNewDeptCode & "' where " & strFieldName & " = " & strOldDeptCode
'Conn.Execute strSQL
RsOldTab.Update

RsOldTab.MoveNext
Step.Value = Step.Value + 1
DoEvents
Loop '循环结束
RsOldTab.Close '关闭被打开的旧表
RsTabList.MoveNext
StepMain.Value = StepMain.Value + 1
DoEvents
Loop '循环结束
RsTabList.Close
Conn.Close
End Sub
------------------------------------------------------------------

Function GetNewDeptCode(ByVal strDeptCode) As String
'根据旧部门编号取得新部门编号
strSQL = "select * from bsjDept where oldCode='" & strDeptCode & "'"
RsDeptOldNew.Open strSQL, Conn
GetNewDeptCode = RsDeptOldNew!newCode
RsDeptOldNew.Close
End Function
-----------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
Set RsTabList = Nothing
Set RsDeptOldNew = Nothing
Set RsOldTab = Nothing
Set Conn = Nothing
End Sub

[cxchina]

recordset打開模式不對﹐
出現這樣大範圍的修改﹐只是說明數据庫
最初設計就有問題﹗
需要這模麻煩嗎﹖
一條語句﹕
tablename 為 數据表名稱
update tableName set (myField=(select newCode from bsjDept where
oldCode=tableName.myField))

[Random]

你的recordset 打开方式不对，用了默认的方式，默认是只读的，应该如下方式打开

.open ,,adOpenKeyset,adLockOptimistic

[Random]

你的recordset 打开方式不对，用了默认的方式，默认是只读的，应该如下方式打开

.open ,adOpenKeyset,adLockOptimistic

[白掌柜]

我用UPDATA语句也改不了，是怎么回事呀？

[白掌柜]

要用什么模式打开才行呀？
客户要求把以前的部门编号完全更改成新的编号，真麻烦，
所有的表都与部门表有关联。

[白掌柜]

如果改成SQL语句
'strSQL = "update " & strTabName & " set " & strFieldName & "='" & strNewDeptCode & "' where " & strFieldName & " = " & strOldDeptCode

这条语句过不去，提示超时。

[Random]

可能是各个表之间关联(即表之间存在主外键关系)的原因，修改后可能会导致数据完整性错误，
因此修改被拒绝

[白掌柜]

表之间没有关系.