I have a password in excel and want to change it in vba

Asked

Viewed 107 times

0

If Me.boxPassword.Value = "12345" Then

    Unload Me
    Sheets("Configuração").Visible = True
    Sheets("Configuração").Select

Else
    Me.Hide
    Retry = MsgBox("Passe incorreta, Tentar outra vez?", vbYesNo, "Retry?")

    Select Case Retry
        Case Is = vbYes
            Me.boxPassword.Value = ""
            Me.boxPassword.SetFocus
            Me.Show

        Case Is = vbNo
            Unload Me

    End Select
End If

This is functional, what I wanted now was to know how to have a method that would allow me to change the password to any other

vba excel-vba

2 answers

0

From the research I did it seems that the only way to change the password of a spreadsheet is to save it with the method Workbook.SaveAs():

' Usando o parâmetro 'Password' o arquivo só poderá ser aberto com a senha. 
Workbooks(1).SaveAs Password:="[nova_senha]"

' Usando o parâmetro 'WriteResPassword', se a senha não for informada o arquivo
' não será poderá ser editado, mas será aberto como somente leitura.
Workbooks(1).SaveAs WriteResPassword:="[nova_senha]"

Sources:

VBA Code to Password Protect an Excel file - Excel off the grid
Setting password on Excel files using VBA - Stack Overflow
Workbook.Saveas Method (Excel) | Microsoft Docs

0

In case you are trying to create your own login system in the spreadsheet has a code that may help you that I use.

Create an object of type Class and paste the information below:

Private Const vShtUsersName As String = "auxUsers"
Private Const vShtTableName As String = "tblSecUsers"
Private Const vAdminName As String = "Admin"
Private Const vAdminDefaulPassValue = "admin"
Private vShtUsers As Worksheet
Private oDicUsers As Object
Private oTable As ListObject

Private Sub Class_Initialize()

    If Not fWorksheetExists(vShtUsersName, ThisWorkbook) Then
        ThisWorkbook.Sheets.Add().Name = vShtUsersName
    End If
    Set vShtUsers = ThisWorkbook.Sheets(vShtUsersName)

    If Not fObjectExists(vShtTableName, vShtUsers) Then
        vShtUsers.Range("A1").Value = "User"
        vShtUsers.Range("B1").Value = "Password"
        vShtUsers.ListObjects.Add(xlSrcRange, vShtUsers.Range("A1:B2"), , xlYes).Name = vShtTableName
    End If
    Set oTable = vShtUsers.ListObjects(vShtTableName)
    sLoad
End Sub

Private Function fWorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    Set sht = wb.Sheets(shtName)
    On Error GoTo 0
    fWorksheetExists = Not sht Is Nothing
End Function

Private Function fObjectExists(ObjName As String, sh As Worksheet) As Boolean
Dim vObject As Variant
    On Error Resume Next
    Set vObject = sh.ListObjects(ObjName)
    On Error GoTo 0
    fObjectExists = Not IsEmpty(vObject)
End Function

Private Sub sLoad()
Dim vArryValues As Variant
Dim i As Long

    Set oDicUsers = CreateObject("Scripting.Dictionary")

    vArryValues = oTable.DataBodyRange.Value

    With oTable.DataBodyRange

        If vArryValues(1, 1) = vbNullString Then
            .Cells(1, 1).Value = vAdminName
            .Cells(1, 2).Value = vAdminDefaulPassValue
        End If

        For i = 1 To UBound(oTable.DataBodyRange.Value, 2) - 1
            oDicUsers.Add .Cells(i, 1).Value, .Cells(i, 2)
        Next i

    End With

End Sub

Public Sub Add(pUserName As String, pPass As String)
Dim vNewRow As ListRow
    If pUserName = vbNullString Then
        MsgBox "Erro, usuario não pode estar em branco"
        Exit Sub
    End If
    Set vNewRow = oTable.ListRows.Add
    vNewRow.Range(1, 1) = pUserName
    vNewRow.Range(1, 2) = pPass
    sLoad
End Sub

Public Sub ChangePassword(pUser As String, pActivePass As String, pNewPass As String)
    If Not (oDicUsers(pUser).Value = pActivePass) Then
        MsgBox "Usuario/Senha invalidos"
        Exit Sub
    End If

    oDicUsers(pUser).Value = pNewPass
    sLoad

End Sub

Public Function ValidAccess(pUser As String, pPass As String) As Boolean
    ValidAccess = (oDicUsers(pUser).Value = pPass)
End Function

Then save the object as: clsUserSecurity

Then Voce can use it as follows:

Public Sub teste()

    Dim oUSec As New clsUserSecurity

    Debug.Print oUSec.ValidAccess("Admin", "admin")

    If oUSec.ValidAccess("Admin", "admin") Then
        oUSec.ChangePassword "Admin", "admin", "hud"
    End If

    Debug.Print oUSec.ValidAccess("Admin", "hud")

End Sub

You can use the code however you like. Note that this object will create its own Sheet to manage users and passwords. But Voce can make the changes to manipulate up to some kind of access level if so prefer.

Browser other questions tagged vba excel-vba

You are not signed in. Login or sign up in order to post.