簡易vb連接sql server實例
需引用Microsoft ActiveX Data Objects
```vbnet
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOW = 5'聯盟訂單回撤
Private Sub Command1_Click()If connT = True ThenDim aa = Text1.TextIf Mid(a, 1, 6) = "LIFEMG" ThenSQL = "update AskForm set State=0 where billno='" & a & "';"RunSQL (SQL)ElseText1.Text = "輸入單號！！！LIFEMG開頭"End IfElseMsgBox ("當前數據庫無法連接，請嘗試連接測試后重試！")End If
End Sub'找回消失的批發銷售單
Private Sub Command3_Click()If connT = True ThenDim bb = Text6.TextIf Mid(b, 1, 3) = "XHC" ThenSQL = "INSERT INTO PFSALEDETAIL SELECT PFSaleNo,SerialNo,PluCode,BarCode,PluName,CargoNo,Spec,ProdArea,Punit,Pcount,Unit,Price,Jprice,NetJPrice, OrnPrice,ZkRate,PFPrice,Counts,ZpCount,PFTotal,ZRTotal,Cost,NetCost,Total,JtaxRate,Tag,DepName,DepCode,Remark, ItemCnt,SglCount,OrnPFTotal,YSTotal,RtnTotal,RtnRate,PluDscTotal,ShareTotal,DscCode,AuthNo,null,null,null,null,null,null,0,0,0,0 FROM PFSaleDetail2 b WHERE b.PFSaleNo='" & a & "';"RunSQL (SQL)ElseText6.Text = "輸入單號！！！XHC開頭"End IfElseMsgBox ("當前數據庫無法連接，請嘗試連接測試后重試！")End If
End Sub'連接測試按鈕
Private Sub Command2_Click()ipadd = Text2.Textdbase = Text3.Textdbpwd = Text4.TextCall ConnectToDataBase
End Sub'直接執行SQL
Private Sub Command4_Click()If connT = True ThenSQL = Text5.TextDim SpwdSpwd = "password"If (Spwd = InputBox("請輸入密碼確認,本操作無法回撤", "謹慎操作，非專業人士勿動", "Input password to continue!", 7000, 7000)) ThenMsgBox ("密碼正確，繼續操作")RunSQL (SQL)ElseMsgBox ("密碼錯誤，非IT請勿操作")End IfElseMsgBox ("當前數據庫無法連接，請嘗試連接測試后重試！")End If
End Sub'其他用戶正在進行日結帳
Private Sub Command5_Click()If connT = True ThenSQL = "delete from SysCfg where Section='SYSTEM' and ItemName='OVER';"RunSQL (SQL)ElseMsgBox ("當前數據庫無法連接，請嘗試連接測試后重試！")End If
End SubPrivate Sub Command8_Click()Call ShellExecute(Me.hWnd, "open", "http://222.72.136.234:8085/knowledgeQA/forum.php", "", "", SW_SHOW)
End Sub'通訊報錯：分公司批發銷售需先同步商品資料
Private Sub Command9_Click()If connT = True ThenSQL = "Truncate table tDRPInfSkuPlu;Truncate table Goods;Update tWebComCtrl set InCreValue=0 where ItemCode='31001';Exec pRcvPlu 01,31001,out;insert into Goods Select * from Goods_bak where Not exists (select 1 from Goods where PluCode= Goods_bak.PluCode);"RunSQL (SQL)ElseMsgBox ("當前數據庫無法連接，請嘗試連接測試后重試！")End If
End Sub'窗口初始化
Private Sub Form_Load()connT = Falseipadd = Text2.Textdbase = Text3.Textdbpwd = Text4.Text'Call Command2_Click
End SubPublic Sub Text1_Click()If Text1.Text = "輸入單號 LIFEMG......" ThenText1.Text = ""End If
End SubPrivate Sub Text5_Click()If Text5.Text = "輸入SQL語句" ThenText5.Text = ""End If
End SubPrivate Sub Text6_Click()If Text6.Text = "輸入單號 XHC......" ThenText6.Text = ""End If
End Sub'數據庫連接測試 --ERR
Function ConnectToDataBase() As BooleanTimer1.Enabled = TrueOn Error GoTo Error1Set myConn = New ADODB.ConnectionmyConn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;password=" & dbpwd & ";Initial Catalog=" & dbase & ";Data Source=" & ipaddmyConn.OpenMsgBox "連接成功！", , "提示"connT = TruemyConn.CloseExit Function
Error1:connT = FalseMsgBox "連接錯誤！請重新輸入數據庫信息" & vbCrLf & Err.Description, , "警告"
End Function'數據庫連接執行語句
Function RunSQL(SQL)Dim cn As New ADODB.ConnectionDim rs As New ADODB.Recordsetcn.ConnectionString = "Provider=SQLOLEDB;Password='" & dbpwd & "';Persist Security Info=False;User ID='sa';Initial Catalog='" & dbase & "';Data Source='" & ipadd & "'"cn.OpenIf rs.State = adStateOpen Then rs.Closers.CursorLocation = adUseClientrs.Open Trim$(SQL), cn, adOpenKeyset, adLockPessimisticcn.CloseMsgBox ("執行完畢！")
End Function```
總結
以上是生活随笔為你收集整理的VB连接SQL SERVER实例的全部內容，希望文章能夠幫你解決所遇到的問題。
如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。
