Option Explicit
Public SQLTables As String
Public SQLFields As String
下面是一个ODBC FRO ORACLE的连接需要总保持它,因为当我双击LIST1的项目时,总要通过它来刷新LIST2的项目
Public cnn2
Public cnn2str
Private Sub addS_Click()
Dim selec1 As String
Dim selec2 As String
Dim list1LI As Integer
Dim list2LI As Integer
Dim addStr As String
Dim selectB As Integer
If List2.Text = "" Then
selectB = MsgBox("¶ÔÕÕ×ֶβ»ÄÜΪ¿Õ!", vbOKOnly, "ϵͳÌáʾ", "0", "0")
Else
selec1 = List1.Text
selec2 = List2.Text
list1LI = List1.ListIndex
list2LI = List2.ListIndex
addStr = selec1 & "." & selec2
List5.AddItem addStr
List2.SetFocus
End If
End Sub
Private Sub button_ok_Click() '根据选项生成SQL语句
Dim i As Integer
Dim listcounts As Integer
List5.SetFocus
TextBox1.Text = ""
listcounts = List5.ListCount
If listcounts <> 0 Then
For i = 0 To listcounts - 1
If i <> listcounts - 1 Then
SQLTables = SQLTables & Left$(List5.List(i), findDot(List5.List(i))) & ","
SQLFields = SQLFields & List5.List(i) & ","
Else
SQLTables = SQLTables & Left$(List5.List(i), findDot(List5.List(i)))
SQLFields = SQLFields & List5.List(i)
End If
Next i
TextBox1.Text = "select " & SQLFields & " from " & SQLTables
Else
MsgBox "ÅäÖÃÐÅϢΪ¿Õ!", , "ϵͳÐÅÏ¢!"
Exit Sub
End If
End Sub
Private Sub button_save_Click()
Dim cnn7
Dim rst7 As New ADODB.Recordset
Dim sqlStrs As String
Dim FirstOrNot As Boolean
YinHao = Chr(39)
Set cnn7 = CreateObject("ADODB.Connection")
cnn7.Open "DRIVER=Microsoft Access Driver (*.mdb);DBQ=e:\vb_wbm\DataPump.mdb"
sqlStrs = "select * from SQLS where strtype='" & Combo1.Text & "'"
rst7.Open sqlStrs, cnn7, adOpenKeyset, adLockOptimistic
'First or not
If rst7.RecordCount = 0 Then
FirstOrNot = True
Else
FirstOrNot = False
End If
'Save it
If FirstOrNot = True Then
rst7.AddNew
rst7.Update rst7.Fields(1).Name, Combo1.Text
rst7.Update rst7.Fields(2).Name, TextBox1.Text ''''*******在这里报错
rst7.Update
rst7.Close
cnn7.Close
Else
rst7.Update rst7.Fields(1).Name, Combo1.Text
rst7.Update rst7.Fields(2).Name, TextBox1.Text
rst7.Close
cnn7.Close
End If
List4.Clear
List5.Clear
End Sub
Private Sub Command1_Click()
Load frm_MakeSql
End Sub
Private Sub delectS_Click()
If List5.Text <> "" Then
List5.SetFocus
List5.RemoveItem List5.ListIndex
Else
Exit Sub
End If
End Sub
Private Sub Form_Load()
Dim rstSchema
Dim cnn1, cnn1str
Dim i As Integer
Dim msg As String
SQLTables = ""
SQLFields = ""
Combo1.AddItem "ÉÌÆ·ÐÅÏ¢"
Combo1.AddItem "ÏúÊÛÐÅÏ¢"
Combo1.AddItem "Éú²úÉÌÐÅÏ¢"
Set cnn2 = CreateObject("ADODB.Connection")
cnn2str = "User ID=" & userIDS & ";Password=" & pwdS & ";Data Source=" & dsnS
cnn2.Open cnn2str
db_initi.List1.Clear
On Error GoTo errormsg
Set cnn1 = CreateObject("ADODB.Connection")
cnn1str = "User ID=" & userIDS & ";Password=" & pwdS & ";Data Source=" & dsnS
cnn1.Open cnn1str
Set rstSchema = cnn1.OpenSchema(adSchemaTables)
Do Until rstSchema.EOF
List1.AddItem rstSchema!TABLE_NAME
rstSchema.MoveNext
Loop
rstSchema.Close
cnn1.Close
errormsg:
Select Case Err.Number
Case -2147217843
msg = "´íÎóµÄÓû§ÃûºÍÃÜÂë!" & Err.Number
MsgBox (msg)
Exit Sub
Case Else
End Select
End Sub
Private Sub List1_DblClick() '刷新LIST2
newfields
End Sub
Private Sub newfields()
Dim i As Integer
Dim strTbName As String
Dim strFldName As String
Dim rslist2 As New ADODB.Recordset
Dim strsql As String
Dim errstr As String
On Error GoTo errmsg3
db_initi.List2.Clear
strTbName = List1.Text
strsql = "select * from " & strTbName & " where 0=1"
rslist2.Open strsql, cnn2
For i = 0 To rslist2.Fields.Count - 1
strFldName = rslist2.Fields(i).Name
List2.AddItem strFldName
Next i
List2.ListIndex = 0
Set rslist2 = Nothing
errmsg3:
Select Case Err.Number
Case -2147217911
errstr = "²»ÄܶÁÈ¡¼Ç¼£»ÔÚ'" & List1.Text & "'ÉÏûÓжÁÈ¡Êý¾ÝȨÏÞ"
MsgBox (errstr)
Exit Sub
Case -2147217900
errstr = "FROM ×Ó¾äÓï·¨´íÎó,¿ÉÄÜÊÇÄúÑ¡ÔñµÄ±íÃû´´½¨µÄÓÐÎÊÌâ¡£ÀýÈ磺ÖмäÓпոñ..."
MsgBox (errstr)
Exit Sub
Case Else
Exit Sub
End Select
End Sub
Private Function findDot(listStr As String) As Long
Dim fanhui As Long
Dim retB
fanhui = InStr(listStr, ".")
If fanhui = Null Or fanhui = 0 Then
retB = MsgBox("Sorry!×Ö·û´®ËÑË÷ÐÅÏ¢ÐÅÏ¢ÓÐÎó!", vbQuestion, "À´×ÔARBSS->findDotµÄ´íÎó")
Else:
findDot = fanhui - 1
End If
End Function
程序挺乱的见笑了!
