 |
首先要有notes sql驱动程序，以下是vb 5.0程序示例
VERSION 5.00
Begin VB.Form NewEmpl
Caption = "New Employee"
ClientHeight = 7176
ClientLeft = 60
ClientTop = 372
ClientWidth = 6468
FillStyle = 2 'Horizontal Line
LinkTopic = "Form1"
ScaleHeight = 7176
ScaleWidth = 6468
StartUpPosition = 2 'CenterScreen
Begin VB.ComboBox GroupName
Height = 315
ItemData = "NewEmpl.frx":0000
Left = 4680
List = "NewEmpl.frx":000A
TabIndex = 35
Top = 840
Width = 1455
End
Begin VB.ComboBox DepartmentName
Height = 315
ItemData = "NewEmpl.frx":0029
Left = 1440
List = "NewEmpl.frx":0030
TabIndex = 33
Top = 840
Width = 2655
End
Begin VB.ComboBox Title
Height = 315
ItemData = "NewEmpl.frx":0052
Left = 3600
List = "NewEmpl.frx":0068
Sorted = -1 'True
TabIndex = 14
Text = "Software Engineer"
Top = 360
Width = 2535
End
Begin VB.TextBox Salary
Height = 285
Left = 1440
TabIndex = 26
Top = 3720
Width = 1695
End
Begin VB.TextBox Hireday
Alignment = 1 'Right Justify
Height = 285
Left = 4920
MaxLength = 10
TabIndex = 25
Top = 3240
Width = 975
End
Begin VB.TextBox Birthday
Alignment = 1 'Right Justify
Height = 285
HideSelection = 0 'False
Left = 1440
MaxLength = 10
TabIndex = 24
Top = 3240
Width = 1005
End
Begin VB.TextBox HomePhone
Height = 285
Left = 4920
TabIndex = 23
Top = 2760
Width = 1215
End
Begin VB.TextBox WorkPhone
Height = 285
Left = 1440
TabIndex = 22
Top = 2760
Width = 1215
End
Begin VB.TextBox ZipCode
Height = 285
Left = 5160
TabIndex = 21
Top = 2280
Width = 975
End
Begin VB.TextBox State
Height = 285
Left = 3840
TabIndex = 20
Top = 2280
Width = 375
End
Begin VB.TextBox City
Height = 285
Left = 1440
TabIndex = 19
Top = 2280
Width = 1695
End
Begin VB.TextBox Address
Height = 285
Left = 1440
TabIndex = 18
Top = 1800
Width = 4695
End
Begin VB.TextBox FirstName
Height = 285
Left = 4440
TabIndex = 17
Top = 1320
Width = 1695
End
Begin VB.TextBox LastName
Height = 285
Left = 1440
TabIndex = 16
Top = 1320
Width = 1695
End
Begin VB.TextBox AddInfo
Height = 1815
Left = 360
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 28
Top = 4560
Width = 5895
End
Begin VB.TextBox Empl_ID
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 255
Left = 1440
Locked = -1 'True
TabIndex = 0
TabStop = 0 'False
Text = "0"
Top = 360
Width = 855
End
Begin VB.CommandButton Exit
Caption = "&Exit"
Height = 375
Left = 4560
TabIndex = 31
Top = 6600
Width = 1695
End
Begin VB.CommandButton Clean
Caption = "&Clean Form"
Height = 375
Left = 2400
TabIndex = 30
Top = 6600
Width = 1815
End
Begin VB.CommandButton Save
Caption = "&Save to Database"
Height = 375
Left = 360
TabIndex = 29
Top = 6600
Width = 1695
End
Begin VB.Label Group
Caption = "Group"
Height = 255
Left = 4200
TabIndex = 34
Top = 840
Width = 495
End
Begin VB.Label Department
Caption = "Department"
Height = 255
Left = 360
TabIndex = 32
Top = 840
Width = 975
End
Begin VB.Label DaySample_Label
Caption = "[01/31/1999]"
Height = 255
Left = 2640
TabIndex = 27
Top = 3240
Width = 1095
End
Begin VB.Label Label1
Caption = "Additional Infomation"
Height = 255
Left = 360
TabIndex = 15
Top = 4200
Width = 1695
End
Begin VB.Label Salary_Label
Caption = "Salary"
Height = 255
Left = 360
TabIndex = 13
Top = 3720
Width = 615
End
Begin VB.Label Hday_Label
Caption = "Date of Hire"
Height = 255
Left = 3840
TabIndex = 12
Top = 3240
Width = 855
End
Begin VB.Label Bday_Label
Caption = "Birthday"
Height = 255
Left = 360
TabIndex = 11
Top = 3240
Width = 735
End
Begin VB.Label Wphone_Label
Caption = "Work Phone"
Height = 255
Left = 360
TabIndex = 10
Top = 2760
Width = 1095
End
Begin VB.Label HPhone_Label
Caption = "Home Phone"
Height = 255
Left = 3840
TabIndex = 9
Top = 2760
Width = 1095
End
Begin VB.Label ZipCode_Label
Caption = "Zip Code"
Height = 255
Left = 4440
TabIndex = 8
Top = 2280
Width = 735
End
Begin VB.Label State_Label
Caption = "State"
Height = 255
Left = 3240
TabIndex = 7
Top = 2280
Width = 495
End
Begin VB.Label City_Label
Caption = "City"
Height = 255
Left = 360
TabIndex = 6
Top = 2280
Width = 495
End
Begin VB.Label Address_Label
Caption = "Address"
Height = 255
Left = 360
TabIndex = 5
Top = 1800
Width = 735
End
Begin VB.Label Title_Label
Caption = "Job Title"
Height = 255
Left = 2760
TabIndex = 4
Top = 360
Width = 855
End
Begin VB.Label FName_Label
Caption = "First Name"
Height = 255
Left = 3480
TabIndex = 3
Top = 1320
Width = 855
End
Begin VB.Label LName_Label
Caption = "Last Name"
Height = 255
Left = 360
TabIndex = 2
Top = 1320
Width = 975
End
Begin VB.Label Empl_ID_Label
Caption = "Employee ID"
Height = 255
Left = 360
TabIndex = 1
Top = 360
Width = 1095
End
End
Attribute VB_Name = "NewEmpl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'(c) 2000 Lotus Development Corporation. All rights reserved. This software
'is subject to the terms of the Lotus Software License Agreement under which
'this software is licensed. Restricted Rights for U.S. government users.
'This software is to be used for illustrative purposes only and is not to be
'used for any other purpose.
Dim rsEmployees As ADODB.Recordset
Dim conn As ADODB.Connection
Private Sub Reload()
Me.Hide
NewEmpl.Show
NewEmpl.LastName.Text = ""
NewEmpl.FirstName.Text = ""
NewEmpl.Address.Text = ""
NewEmpl.City.Text = ""
NewEmpl.ZipCode.Text = ""
NewEmpl.State.Text = ""
NewEmpl.WorkPhone.Text = ""
NewEmpl.HomePhone.Text = ""
NewEmpl.Birthday.Text = ""
NewEmpl.Hireday.Text = ""
NewEmpl.Salary.Text = ""
NewEmpl.AddInfo.Text = ""
NewEmpl.DepartmentName.Text = ""
NewEmpl.GroupName.Text = ""
NewEmpl.Hireday.Text = Format(Now, "mm/dd/yyyy")
End Sub
Private Sub Clean_Click()
'Clear all input
Call Reload
End Sub
Private Sub Exit_Click()
'Close the ADO connection object
rsEmployees.Close
conn.Close
End
End Sub
Private Sub Form_Load()
' Connect to a Database
Set conn = CreateObject("ADODB.Connection")
'There are two ways you can make a connetion to the NotesSql Sample database
'1.) One way is to use a DSN
conn.ConnectionString = "DSN=NotesSQL_SampleDB"
'
'2.) The other way is to call the NotesSQL driver with the Database Location
'conn.ConnectionString = "DRIVER=""Lotus NotesSQL Driver (*.nsf)"";" + "DATABASE=c:\Notes\data\NotesSQL_Sample.nsf;"
conn.Open
Dim szSQL As String
szSQL = "Select MAX(EmployeeID) FROM Employee"
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open szSQL, conn, , , adCmdText
iEmpID = rs.Fields.Item(0).Value
rs.Close
'Set the default information
Empl_ID.Text = iEmpID + 1
'Set the start day to be today
Hireday.Text = Format(Now, "mm/dd/yyyy")
' Open the Employee table.
Set rsEmployees = New ADODB.Recordset
rsEmployees.ActiveConnection = conn
rsEmployees.CursorLocation = adUseClient
rsEmployees.CursorType = adOpenKeyset
rsEmployees.LockType = adLockOptimistic
rsEmployees.Open "Employee"
End Sub
Private Sub Save_Click()
Dim szLastName As String
Dim szFirstName As String
Dim szTitle As String
Dim szAddress As String
Dim szCity As String
Dim szState As String
Dim szCountry As String
Dim szWorkPhone As String
Dim szHomePhone As String
Dim szAdditInfo As String
Dim szZipCode As String
Dim LEmplID As Long
Dim DbSalary As Double
Dim DtHireDate As Date
Dim DtBirthDay As Date
Dim szBday As Variant
Dim szHday As Variant
Dim szDepartmentName As String
Dim szGroupName As String
' Get data from the user.
szLastName = Trim(NewEmpl.LastName.Text)
szFirstName = Trim(NewEmpl.FirstName.Text)
szTitle = Trim(NewEmpl.Title.Text)
szAddress = Trim(NewEmpl.Address.Text)
szCity = Trim(NewEmpl.City.Text)
szState = Trim(NewEmpl.State.Text)
szWorkPhone = Trim(NewEmpl.WorkPhone.Text)
szHomePhone = Trim(NewEmpl.HomePhone.Text)
szAdditInfo = Trim(NewEmpl.AddInfo.Text)
LEmplID = CLng(Trim(NewEmpl.Empl_ID.Text))
szZipCode = Trim(NewEmpl.ZipCode.Text)
szDepartmentName = Trim(NewEmpl.DepartmentName.Text)
szGroupName = Trim(NewEmpl.GroupName.Text)
' Proceed only if the user actually entered something
If (szLastName <> "") And (szFirstName <> "") And (szCity <> "") _
And (szTitle <> "") And (szAddress <> "") _
And (szState <> "") _
And (szZipCode <> "") And (szWorkPhone <> "") _
And (Hireday.Text <> "") And (Birthday.Text <> "") And _
(Salary.Text <> "") And (szHomePhone <> "") Then
' Make sure that birthday date and hire day
' are in the correct format.
If ((Not IsDate(Birthday.Text)) Or (Not IsDate(Hireday.Text))) Then
MsgBox "The date for either birthday or hire day is not in the correct format. Please retry."
Exit Sub
End If
' Make sure that the input for salary field is number
If (Not IsNumeric(Salary.Text)) Then
MsgBox "Invalid value for salary. Please retry."
Exit Sub
End If
' Insert a new Record into the sample database
rsEmployees.AddNew
rsEmployees!EmployeeID = LEmplID
rsEmployees!Title = szTitle
rsEmployees!LastName = szLastName
rsEmployees!FirstName = szFirstName
rsEmployees!Address = szAddress
rsEmployees!City = szCity
rsEmployees!State = szState
rsEmployees!ZipCode = szZipCode
rsEmployees!HomePhone = szHomePhone
rsEmployees!WorkPhone = szWorkPhone
DbSalary = CDbl(Trim(NewEmpl.Salary.Text))
rsEmployees!Salary = DbSalary
' VB5 date function CDate
' This function will convert any year from 1930 through 2029 into a two digit year
' For example: 01/01/2010 will be converted into 1/1/10
' Any other year will be in four digit year
DtHireDate = CDate(Trim(NewEmpl.Hireday.Text))
DtBirthDay = CDate(Trim(NewEmpl.Birthday.Text))
rsEmployees!Birthday = Format(DtBirthDay, "mm/dd/yyyy")
rsEmployees!HireDate = Format(DtHireDate, "mm/dd/yyyy")
If (szDepartmentName <> "") Then
rsEmployees!DepartmentName = szDepartmentName
Else
rsEmployees!DepartmentName = Null
End If
If (szGroupName <> "") Then
rsEmployees!GroupName = szGroupName
Else
rsEmployees!GroupName = Null
End If
If (szAdditInfo <> "") Then
rsEmployees!AdditionalInfo = szAdditInfo
Else
rsEmployees!AdditionalInfo = Null
End If
rsEmployees.Update
Call Reload
Empl_ID.Text = LEmplID + 1
Else
' The user does not complete all the required inputs
MsgBox "Missing Input"
End If
End Sub
此问题由裴庆斌回答。
附加关键字：编程, 源程序, programming, source code, Visual Basic, VB, 数据库, database, query。
|
如何用VB访问LOTUS NOTES 数据库
