你可以这样做建一个模块在里面输入下列
Public conn As ADODB.Connection
Sub main()
Set conn = New ADODB.Connection
conn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;" _
+ "User ID=sa;password=sa;Initial Catalog=您的数据库名;Data Source=127.0.0.1"
conn.Open
from1.Show ’登录界面
End Sub

再在登录界面“确定”下写入如下代码：
Private Sub Command1_Click()
If id.Text = "" Then
MsgBox "用户名不能为空！", vbOKOnly + vbInformation, "友情提示"
id.SetFocus
Exit Sub
End If
If password.Text = "" Then
MsgBox "密码不能为空！", vbOKOnly + vbInformation, "友情提示"
password.SetFocus
Exit Sub
End If

Dim strSQl As String
strSQl = "select * from Users where users_name='" & Trim$(id.Text) & "' and password='" & Trim$(password.Text) & "' "

Dim str As New ADODB.Recordset
Set str = New ADODB.Recordset
str.CursorLocation = adUseClient
str.Open strSQl, conn, adOpenStatic, adLockReadOnly

With str
If .State = adStateOpen Then .Close
.Open strSQl
If .EOF Then
Try_times = Try_times + 1
If Try_times >= 3 Then
MsgBox "您已经三次尝试进入本系统，均不成功，系统将自动关闭", vbOKOnly + vbCritical, "警告"
Unload Me
Else
MsgBox "对不起，用户名不存在或密码错误 ！", vbOKOnly + vbQuestion, "警告"
id.SetFocus
id.Text = ""
password.Text = ""
End If
Else

Unload Me

Form2.Show ’登录进入的另一个界面

End If
End With

End Sub

需要　combo　command　text　控件各一个！　和一　access　数据库　和　程序在同一路径下！　有一个　用户表　！表里有　姓名　和　密码　两列！


Dim db As Database
Dim rs As Recordset

Private Sub Form_Load()
Set db = OpenDatabase(App.Path & "数据库名.mdb", False, False, ";pwd=数据库密码")
Set rs = db.OpenRecordset("表名")
Dim i As String
For t = 0 To Val(rs.RecordCount) - 1
i = Trim(rs.Fields("姓名").Value)
rs.MoveNext
Combo1.AddItem i
Next
rs.Close
End Sub

Private Sub Command1_Click()
Set db = OpenDatabase(App.Path & "\数据库名.mdb", False, False, ";pwd=数据库密码")
Set rs = db.OpenRecordset("select * from 表名 where 姓名='" & Combo1.Text & "' and 密码='" & Text1.Text & "'")
If Combo1.Text <> "" Then
If rs.EOF = True And rs.BOF = True Then
n = MsgBox(" 密码错误！请重试!", vbExclamation)
Text1.Text = ""
Text1.SetFocus
Else

MsgBox ("登陆成功！")
Form２.Show　　＇要打开的窗口名称
rs.Close
Unload Form1
End If
Else
n = MsgBox(" 请选择用户名！", vbExclamation)
End If
End Sub

[此贴子已经被作者于2006-12-18 10:34:52编辑过]

这是我做的一个类模块：
Option Explicit

''''''''''用户名''''''''''

Public UserName As String
Public OldUserName As String
Public NewUserName As String

'''''''''密码'''''''''''''''''

Public PassWord As String
Public OldPassWord As String
Public NewPassWord As String

'''''''''描述、备注'''''''''''

Public Purview As String ''''描述
Public ReMark As String ''''备注

Public ValidatePWDCode As String ''''密码验证码
Public IfPassPWDValidate As Boolean ''''是否通过密码验证

Public ErrCount As Integer ''''错误次数

Public OperatorEnumes As OperatorEnume ''''操作级别

'''''''操作级别枚举'''''''''''

Public Enum OperatorEnume
Guest = 0
Administrator = 2603
SuperUserAdministrator = 2756

End Enum

Public ViseLetter As Boolean '''''''签署函

Private blnIfPassNameAndPwd As Boolean ''''是否通过用户名和密码验证(内部使用)

Private Db As New ADO_DBOption.DataBaseOperation
Private Rs As New ADODB.Recordset

Private LinkString As String
Private Const UserName1 = "admin"
Private Const PassWord1 = ""

Private Const TableName As String = "users"
Private FieldName As String
Private GroupBy As String
Private OrderBy As String
Private Condition As String

'''''''''''是否通过用户名和密码验证属性

Public Property Get PassNameAndPwd(ByVal blnPassNameAndPwd As Boolean) As Boolean
PassNameAndPwd = ValidateNameAndPWD(blnPassNameAndPwd)

End Property

'''''''''''''''输入用户名和密码，并验证'''''''''''''''''

Private Function ValidateNameAndPWD( _
ByVal blnPassNameAndPwd As Boolean _
) As Boolean


'''''如果传值通过，则通过，不需再验证''''

If blnPassNameAndPwd = True Then
ValidateNameAndPWD = blnPassNameAndPwd
Exit Function

End If


'''''如果传值未通过，则需验证''''

Dim FrmEx As New FrmExamination

With FrmEx
If blnIfPassNameAndPwd = False Then
.Show 1
blnIfPassNameAndPwd = FrmEx.blnIfPassCheck

Me.ErrCount = .ErrCount
Me.OperatorEnumes = .OperatorEnumes
Me.UserName = .UserName
Me.PassWord = .PassWord

End If

End With

If blnIfPassNameAndPwd = True And Me.ErrCount <= 2 Then
ValidateNameAndPWD = True

Else
ValidateNameAndPWD = False

End If

Set FrmEx = Nothing

End Function

Private Sub Class_Initialize()
blnIfPassNameAndPwd = False

LinkString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Users.mdb;Persist Security Info=False"
FieldName = "*"
Set Rs = Db.GetRecordset(LinkString, UserName, PassWord, TableName, FieldName)

End Sub

Private Sub ShowEditAdministratorWindow( _
ByVal UserName As String, _
ByVal PassWord As String)

With FrmEdit
.Ex.UserName = Me.UserName
.Ex.PassWord = Me.PassWord

.Show

End With
End Sub

Private Sub ShowEditSuperUserWindow()
FrmEditG.Show

End Sub

'''''''''''''验证用户名和密码，返回用户级别''''''''''''

Public Function Check( _
ByVal strUserName As String, _
ByVal strPassWord As String) As Boolean

blnIfPassNameAndPwd = False
Me.UserName = strUserName
Me.PassWord = strPassWord
Me.OperatorEnumes = Guest

If Rs.AbsolutePosition = adPosUnknown Then Exit Function

Rs.MoveFirst
Do Until Rs.EOF
If Me.UserName = Rs.Fields(1) And Me.PassWord = Rs.Fields(2) & "" Then
blnIfPassNameAndPwd = True
Exit Do

Else


End If

Rs.MoveNext

Loop

Rs.MoveFirst
Do Until Rs.EOF
If Me.UserName = Rs.Fields(1) And Me.PassWord = Rs.Fields(2) & "" Then
If Rs.Fields(3) = "管理员" Then
Me.OperatorEnumes = Administrator

ElseIf Rs.Fields(3) = "超级用户" Then
Me.OperatorEnumes = SuperUserAdministrator

Else
Me.OperatorEnumes = Guest

End If

Exit Do
End If

Rs.MoveNext

Loop

Check = blnIfPassNameAndPwd

End Function

''''''''''验证密码''''''''''''

Public Function ValidatePassWord( _
ByVal strPassWord As String, _
ByVal strValidatePWDCode As String _
) As Boolean

If strPassWord = strValidatePWDCode Then
ValidatePassWord = True

Else
ValidatePassWord = False

End If

End Function

Public Sub Management()
On Error Resume Next

If PassNameAndPwd(False) = True Then
If OperatorEnumes = SuperUserAdministrator Then
ShowEditSuperUserWindow

ElseIf OperatorEnumes = Administrator Then
ShowEditAdministratorWindow Me.UserName, Me.PassWord

Else
MsgBox "操作权限不够！", 48

End If

Else
MsgBox "未通过用户和密码验证！", 48

End If

End Sub

Private Sub Class_Terminate()
blnIfPassNameAndPwd = False

End Sub