Secure Workbook

For security reasons, you may want to set password for your workbook, so unauthorized user can not use that workbook. There are two method to secure the workbook, one is set password in the excel workbook and other is authenticate user from the database(Access, Oracle, Ms-Server etc) where user information is already exist in login relation.

Private Sub CommandButton1_Click()
Dim pwd1 As String
Dim pwd2 As String

  pwd1 = InputBox("Please enter the Password.")
  pwd2 = InputBox("Re-enter Password.")

While pwd1 <> pwd2

  MsgBox ("Password is Different.")
  pwd1 = InputBox("Please enter the Password.")
  pwd2 = InputBox("Re-enter Password.")

Wend

  ThisWorkbook.Password = pwd1
  MsgBox ("Password successfully updated.")


End Sub




Second Method:




Private Sub Workbook_Open()

 Login.Show

End Sub



Public Function closeworkbook() ‘module code

 ThisWorkbook.Close

End Function





Dim cuname As String, cpass As String, count As Integer



Private Sub CommandButton1_Click()

'   Set Reference in Tools to: Microsoft ActiveX Data Objects 2.x Library
    Dim DBFullName As String, Uname As String, pass As String
    Dim Cnct As String, Src As String
    Dim Connection As ADODB.Connection
    Dim Recordset As ADODB.Recordset
    Dim col As Long
    
    
    Uname = Usernametxt.Text
    pass = Passwordtxt.Text
        
'   Database information
    DBFullName = "D:\LoginDataBase.mdb"


'   Open the connection
    Set Connection = New ADODB.Connection
    Cnct = "Provider=Microsoft.Jet.OLEDB.4.0; "
    Cnct = Cnct & "Data Source=" & DBFullName & ";"
    Connection.Open ConnectionString:=Cnct
    
'   Create RecordSet
    Set Recordset = New ADODB.Recordset
'   Record locking
   
   With Recordset
     .CursorType = adOpenKeyset
     .LockType = adLockOptimistic
    

'       Filter
        Src = "SELECT * FROM Login WHERE User_Name = '" & Uname & "' and password='" & pass & "' "
        
        .Open Source:=Src, ActiveConnection:=Connection
        cuname = .Fields("User_Name").Value
        cpass = .Fields("Password").Value
        
   End With

   If Uname <> cuname Or pass <> cpass Then

     MsgBox "Please Check the Username and Password", vbCritical, "No Detail Found"
     count = count + 1
 
     If count > 2 Then

          Call CommandButton2_Click

     End If

     Usernametxt.SetFocus

   Else

    Set Recordset = Nothing
    Connection.Close
    Set Connection = Nothing
    Usernametxt.Text = ""
    Passwordtxt.Text = ""
    Unload Me

   End If

End Sub



Private Sub CommandButton2_Click()

 closeworkbook

End Sub




Private Sub UserForm_Terminate()
  If cuname = "" Or cpass = "" Then
  closeworkbook
End If


End Sub