Private Sub Command1_Click()
Dim SQL As String
SQL = "select * from T_MAIN_SOURCE "
Set rs1 = TransactSQL(SQL)
If rs1.EOF = True Then
MsgBox "源表没有内容", vbOKOnly + vbExclamation, ""
Else '检验源表是否有数据
Do While rs1.EOF
Set rs2 = TransactSQL("select * from P_PATMAIN where PATNO='" & rs1.Field("PATNO") & "'")
If rs2.EOF = True Then
TransactSQL ("insert into P_PATMAIN (PATNO) values('" & rs1.Field("PATNO") & "')")
End If
rs2.Close
rs1.MoveNext
Loop
End If
rs1.Close
MsgBox "处理完成", vbOKOnly + vbExclamation, ""
Unload Me
End Sub
MODULE1代码:
Public flag As Integer '添加和修改的标志
Public gSQL As String '保存SQL语句
Public iflag As Integer '数据库是否打开标志
Private Function TransactSQL(ByVal SQL As String) As ADODB.Recordset
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConnection As String
Dim strArray() As String
Set con = New ADODB.Connection '创建连接
Set rs = New ADODB.Recordset '创建记录集
On Error GoTo TransactSQL_Error
strConnection = "Provider=Microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\Data.mdb"
strArray = Split(SQL)
con.Open strConnection '打开连接
If StrComp(UCase$(strArray(0)), "select", vbTextCompare) = 0 Then
rs.Open Trim$(SQL), con, adOpenKeyset, adLockOptimistic
Set TransactSQL = rs '返回记录集
iflag = 1
Else
con.Execute SQL '执行命令
iflag = 1
End If
TransactSQL_Exit:
Set rs = Nothing
Set con = Nothing
Exit Function
TransactSQL_Error:
MsgBox "查询错误：" & Err.Description
iflag = 2
Resume TransactSQL_Exit
End Function
