Option Compare Database
Option Explicit
Dim Objexcel As Excel.Application
Dim ObjWB As Workbook
Dim ws As Worksheet
Dim r As Range
Dim MyFile As String, pw As String 'password for the Excel file
Dim pwAccess As String 'pasword for the Access file
Private Sub cmd_OK_Click()
MyFile = CurrentProject.Path & "\Passwords.xlsx"
pw = "test"
Set Objexcel = New Excel.Application
Set ObjWB = Objexcel.Workbooks.Open(FileName:=MyFile, Password:=pw, writerespassword:=pw)
Set ws = ObjWB.ActiveSheet
Set r = ws.Range("A1").CurrentRegion.Columns(1)
pwAccess = r.Find(cbo_UserName.Value).Offset(0, 1)
ObjWB.Close savechanges:=False
Objexcel.Quit
Set Objexcel = Nothing
Set ObjWB = Nothing
'MsgBox pwAccess
If txt_Password = pwAccess Then
cmd_ChangePassword.Enabled = True
txt_NewPassword.Enabled = True
txt_NewPassword.SetFocus
Else
MsgBox "Wrong Password"
End If
End Sub
Private Sub cmd_ChangePassword_Click()
MyFile = CurrentProject.Path & "\Passwords.xlsx"
pw = "test"
Set Objexcel = New Excel.Application
Set ObjWB = Objexcel.Workbooks.Open(FileName:=MyFile, Password:=pw, writerespassword:=pw)
Set ws = ObjWB.ActiveSheet
Set r = ws.Range("A1").CurrentRegion.Columns(1)
r.Find(cbo_UserName.Value).Offset(0, 1).Value = txt_NewPassword
ObjWB.Close savechanges:=True
Objexcel.Quit
Set Objexcel = Nothing
Set ObjWB = Nothing
MsgBox "done"
'DoCmd.Close
End Sub