查询数据库所有表所有字段的某个值，生成更新代码 (VB)

以下是公共模块

Code

VERSION 5.00

Begin VB.Form Form1

Caption = "替换"

ClientHeight = 7680

ClientLeft = 60

ClientTop = 345

ClientWidth = 10650

LinkTopic = "Form1"

ScaleHeight = 7680

ScaleWidth = 10650

StartUpPosition = 3 '窗口缺省

Begin VB.TextBox Text4

Height = 4575

Left = 120

MultiLine = -1 'True

ScrollBars = 3 'Both

TabIndex = 7

Top = 2880

Width = 10455

End

Begin VB.TextBox Text3

Height = 375

Left = 1440

TabIndex = 5

Text = "Provider=SQLOLEDB;Data Source=.\sqlexpress;Initial Catalog=test;User ID=sa;Password=12345678"

Top = 1440

Width = 8535

End

Begin VB.TextBox Text2

Height = 375

Left = 1440

TabIndex = 2

Text = "SZX"

Top = 840

Width = 8535

End

Begin VB.CommandButton Command1

Caption = "开始"

Height = 495

Left = 2760

TabIndex = 1

Top = 2040

Width = 4575

End

Begin VB.TextBox Text1

Height = 375

Left = 1440

TabIndex = 0

Text = "SFT"

Top = 240

Width = 8535

End

Begin VB.Label lblP

AutoSize = -1 'True

Caption = "Cick it"

Height = 180

Left = 7800

TabIndex = 8

Top = 2160

Width = 630

End

Begin VB.Label Label2

AutoSize = -1 'True

Caption = "数据库:"

Height = 180

Left = 480

TabIndex = 6

Top = 1560

Width = 630

End

Begin VB.Label Label1

AutoSize = -1 'True

Caption = "替换:"

Height = 180

Index = 1

Left = 480

TabIndex = 4

Top = 960

Width = 450

End

Begin VB.Label Label1

AutoSize = -1 'True

Caption = "查找:"

Height = 180

Index = 0

Left = 480

TabIndex = 3

Top = 360

Width = 450

End

End

Attribute VB_Name = "Form1"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

Dim mystr As String

Dim b As Boolean

Private Sub Command1_Click()

If Command1.Caption = "开始" Then

Command1.Caption = "停止"

StrC = Text3.Text

Text4.Text = ""

Call start

'Command1_Click

Command1.Caption = "开始"

ElseIf Command1.Caption = "停止" Then

Command1.Caption = "开始"

End If

End Sub

Sub start()

Dim rs As New ADODB.Recordset

Dim rs1 As New ADODB.Recordset

Dim t As String

Dim f As String

Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long

Set rs = ExecSql("select name from sysobjects where type='U' ", mystr)

If rs.EOF Then Exit Sub

i1 = 0

i2 = 0

i3 = 0

rs.MoveLast

rs.MoveFirst

i4 = rs.RecordCount

SetLab i1, i2, i3, i4

Do While Not rs.EOF

If Command1.Caption = "开始" Then Exit Sub

DoEvents

i3 = i3 + 1

SetLab i1, i2, i3, i4

t = "[" & rs.Fields(0) & "]"

't = t & Space(40 - Len(t))

Set rs1 = ExecSql("Select Name from SysColumns Where id=Object_Id('" & t & "') and xtype in ( select xtype from systypes where name in ( 'varchar ', 'nvarchar', 'char', 'nchar') )", mystr)

If Not rs1.EOF Then

rs1.MoveLast

rs1.MoveFirst

i2 = rs1.RecordCount

Do While Not rs1.EOF

DoEvents

i1 = i1 + 1

SetLab i1, i2, i3, i4

f = "[" & rs1.Fields(0) & "]"

If Val(GetName(" select count(1) from " & t & " where " & f & " = '" & Text1.Text & "'")) > 0 Then

Text4.Text = Text4.Text & " update " & t & Space(40 - Len(t)) & " set " & f & Space(30 - Len(f)) & "='" & Text2.Text & "' where " & f & Space(30 - Len(f)) & " = '" & Text1.Text & "'" & vbCrLf

End If

rs1.MoveNext

Loop

End If

i1 = 0

rs.MoveNext

Loop

End Sub

Sub SetLab(i1 As Long, i2 As Long, i3 As Long, i4 As Long)

lblP.Caption = "Current:" & i1 & "/" & i2 & vbCrLf & "Total:" & i3 & "/" & i4

Text4.SelStart = Len(Text4.Text)

End Sub