frmhwbmquery.frm

用vb和SQLSERVER编译的关于数据库的源程序例子。

VERSION 5.00
Begin VB.Form frmHwbmQuery 
   ClientHeight    =   1785
   ClientLeft      =   4425
   ClientTop       =   3330
   ClientWidth     =   6945
   LinkTopic       =   "Form1"
   ScaleHeight     =   1785
   ScaleWidth      =   6945
   Begin VB.ComboBox Combo 
      Height          =   300
      Index           =   0
      Left            =   1290
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   240
      Width           =   1725
   End
   Begin VB.Label Label 
      Caption         =   "货物分类:"
      Height          =   195
      Index           =   2
      Left            =   420
      TabIndex        =   1
      Top             =   300
      Width           =   825
   End
End
Attribute VB_Name = "frmHwbmQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'定义连接数据库的Conn对象变量
Dim Conn As ADODB.Connection

Const CbxHwBmFlCode = 0

'加载窗体时执行
Private Sub Form_Load()
On Error GoTo Errorhandle
   
   '调用Connection过程与数据库建立连接
   Connection
   
   '调用LoadHwFl过程从数据库取出数据在ComboBox控件列出
   LoadHwFl
      
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

'与数据库建立连接
Private Sub Connection()
   Dim ConnStr As String
On Error GoTo Errorhandle

   ConnStr = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Password=;Initial Catalog=fiterp;Data Source=ERP002"

   Set Conn = New ADODB.Connection
   Conn.ConnectionString = ConnStr
   Conn.Open
   
Exit Sub
Errorhandle:
   Set Conn = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

'从数据库取出数据在ComboBox控件列出
Private Sub LoadHwFl()
   Dim Rs As ADODB.Recordset
On Error GoTo Errorhandle
   
   '将ComboBox控件内容清空
   Combo(CbxHwBmFlCode).Clear
   
   '产生一个新的记录集，并从数据库中取出数据
   Set Rs = New ADODB.Recordset
   Set Rs.ActiveConnection = Conn
   
   Rs.Open "SELECT HWFLCODE,HWFLMC FROM HWFLREC ORDER BY HWFLCODE"
   
   '对记录集进行循环，将数据一行一行在ComboBox控件显示
   Do While Not Rs.EOF
      Combo(CbxHwBmFlCode).AddItem Rs("HWFLCODE") & vbTab & Rs("HWFLMC")
      Rs.MoveNext
   Loop
   
   Rs.Close
   Set Rs = Nothing
   
Exit Sub
Errorhandle:
   Set Rs = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub