2 Cara Mudah Reset Password VBA Office Excel

Aplikasi berbasis MS. Excel banyak dikembangkan oleh para creator-creator handal dengan skil berbasis MS. Excel. Sebut saja dalam dunia pendidikan banyak dikembangkan aplikasi tersebut.

Bagi kita yang penasaran akan rumus dan script yang digunakan dalam MS Excel itu sendiri, tentunya membuat kita "GATAL" untuk megotak-atik aplikasi tersebut. Namun, hal yang paling menjengkelkan ketika mendapatkan aplikasi yang bagus harus menghadapi LOCK atau aplikasi tersebut di PASSWORD. Dalam EXCEL sangat memungkingkan dipasswor, baik SHEET maupun MACRO yang digunakan.

Berikut akan dijelaskan cara membuka password dalam macro.

Cara 1.
Cara 1 ini kalian dapat menggunakan aplikasi rvba.exe. atau aplikasi remove vba exce.
1. Download aplikasi rvba.exe di sini versi lawas atau versi baru.
2. Instal aplikasi rvba.exe tersebut seperti biasanya
3. Masukkan file excel yang akan di reset password vba nya.
4. Klik gambar gembok terbuka pada aplikasi.
5. Taraaa,, file excel sudah terbebas dari password vba nya.
6. Kurang jelas? Perhatikan video berikut


Cara 2
Cara 2 ini kalian dapat menggunakan macro. Lho, kok dengan macro? kan aplikasinya terkunci dibagian macro....
Tenang, cara ini menggunakan file excel baru, jadi kita membuat file excel untuk memasang macro, kemudian kita buka/open file excel yang terkunci macronya dengan file excel yang baru ini.

Lebih jelasnya, perhattikan video berikut ini...

Script untuk cara ke 2, atau download file text script nya di sini (update 11/08/2020)

<br /> Option Base 1<br /> Function ProtectedVBProject(ByRef wb As Workbook) As Boolean<br /> ' returns TRUE if the VB project in the active document is protected<br /> Dim VBC As Integer<br /> VBC = -1<br /> On Error Resume Next<br /> VBC = wb.VBProject.VBComponents.Count<br /> On Error GoTo 0<br /> If VBC = -1 Then<br /> ProtectedVBProject = True<br /> Else<br /> ProtectedVBProject = False<br /> End If<br /> End Function<br /> <br /> Sub GeneralSub()<br /> Dim CopyFname As Variant<br /> Dim FileNameFolder As Variant<br /> ChDir (Environ("USERPROFILE") & "\Desktop")<br /> 'Select the file<br /> Fname = Application.GetOpenFilename(filefilter:="Excel files (*.xlsm), *.xlsm", MultiSelect:=False)<br /> 'Check if file selected<br /> If Fname = False Then<br /> Exit Sub<br /> End If<br /> ''Check if workBook has password for opening<br /> On Error Resume Next<br /> Dim tmpWB As Workbook<br /> Set tmpWB = Workbooks.Open(Fname, ReadOnly:=True, Password:="")<br /> If Err.Number > 0 Then<br /> MsgBox "Selected Workbook is encrypted (Password for Openning)!" & vbCrLf & "This program doesn't works with such files.", vbCritical, "VBA Unlocker"<br /> Exit Sub<br /> End If<br /> On Error GoTo 0<br /> ''Check if WorkBook is in Shared mode<br /> If tmpWB.MultiUserEditing = True Then<br /> ''Close WorkBook<br /> tmpWB.Close saveChanges:=False<br /> MsgBox "Selected Workbook is in Shared Mode!" & vbCrLf & "Please change mode to Exclusive (non Shared) and try again", vbExclamation, "VBA Unlocker"<br /> Exit Sub<br /> End If<br /> ''Check if VBProjec protected<br /> ProjectProtected = ProtectedVBProject(tmpWB)<br /> ''Close WorkBook<br /> tmpWB.Close saveChanges:=False<br /> Set tmpWB = Nothing<br /> '' Check if converting to ZIP is required<br /> If ProjectProtected Then<br /> ''Create Scripting Object<br /> Dim FSO As Object<br /> Set FSO = CreateObject("scripting.filesystemobject")<br /> 'Copy the file with .zip extension<br /> CopyFname = Left(Fname, Len(Fname) - 4) & "zip"<br /> LastSeparatorPos = Len(CopyFname) - InStr(1, StrReverse(CopyFname), CStr(Application.PathSeparator), vbTextCompare) + 1<br /> CopyFname = Left(CopyFname, LastSeparatorPos) & "Unlocked_" & Right(CopyFname, Len(CopyFname) - LastSeparatorPos)<br /> FSO.CopyFile Fname, CopyFname, True <br /> ''Path to tmp folder<br /> FileNameFolder = Environ("tmp") & "\UnlockFolderTMP" <br /> ''Delete if previous files exists<br /> If FSO.FolderExists(FileNameFolder & "\") Then<br /> FSO.deletefolder FileNameFolder<br /> End If<br /> 'Make the tmp folder in User tmp<br /> FSO.CreateFolder FileNameFolder<br /> End If<br /> Dim OutMSG As String<br /> OutMSG = ""<br /> 'Check whether WorkBook has VBA Project protection<br /> If ProjectProtected = True Then<br /> OutMSG = ChangePasswordForVBA(CopyFname, FileNameFolder)<br /> Else<br /> OutMSG = "Selected WorkBook has no VBA Project protection."<br /> End If<br /> ''Check if returning to previous state is required<br /> If ProjectProtected Then<br /> ''Delete tmp files--------------------------<br /> If FSO.FolderExists(FileNameFolder & "\") Then<br /> FSO.deletefolder FileNameFolder<br /> End If<br /> ''Change extension to .xlsm<br /> CopyFname_unlocked = Left(CopyFname, Len(CopyFname) - 3) & "xlsm"<br /> ''Delete file with the same name if exists<br /> If FSO.FileExists(CopyFname_unlocked) Then<br /> FSO.DeleteFile CopyFname_unlocked, True<br /> End If<br /> ''Rename back to .xlsm file<br /> FSO.MoveFile CopyFname, CopyFname_unlocked<br /> Set FSO = Nothing<br /> End If<br /> MsgBox OutMSG, vbInformation, "VBA Unlocker"<br /> End Sub<br /> Function ChangePasswordForVBA(CopyFname As Variant, FileNameFolder As Variant) As String<br /> 'Object for work with ZIP file<br /> Set oApp = CreateObject("Shell.Application")<br /> ''Set to false<br /> ProjectFileFound = False<br /> ''Cycle trought Zip archive<br /> For Each fileNameInZip In oApp.Namespace(CopyFname).items<br /> 'find 'xl' folder<br /> If fileNameInZip = "xl" Then<br /> 'find vbaProject.bin<br /> For Each subFile In fileNameInZip.Getfolder.items<br /> 'extract 'vbaProject.bin' file<br /> If subFile = "vbaProject.bin" Then<br /> ''Move bin file to tmp folder<br /> oApp.Namespace(FileNameFolder).movehere subFile<br /> ProjectFileFound = True<br /> Exit For<br /> End If<br /> Next<br /> End If<br /> Next<br /> ''HASH for Password = 'macro'<br /> Dim PasswordString As String<br /> PasswordString = "282A84CBA1CBA1345FCCB154E20721DE77F7D2378D0EAC90427A22021A46E9CE6F17188A"<br /> ''if VbaProject exists<br /> If ProjectFileFound = True Then<br /> tmpMSG = ""<br /> tmpMSG = ChangeDPBValue(FileNameFolder & "\vbaProject.bin", PasswordString) ''DPB change<br /> ''Overwirte existing vbaProject.bin file<br /> oApp.Namespace(CopyFname).items.Item("xl").Getfolder.CopyHere FileNameFolder & "\vbaProject.bin"<br /> 'Keep script waiting until Compressing is done<br /> On Error Resume Next<br /> Do Until oApp.Namespace(CopyFname).items.Item("xl").Getfolder.items.Item("vbaProject.bin").Name = "vbaProject.bin"<br /> Application.Wait (Now + TimeValue("0:00:01"))<br /> Loop<br /> On Error GoTo 0<br /> If tmpMSG = "" Then<br /> ChangePasswordForVBA = "Password for VbaProject: 'macro'"<br /> Else<br /> ChangePasswordForVBA = tmpMSG<br /> End If<br /> Else<br /> ChangePasswordForVBA = "File don't have VbaProject!"<br /> End If<br /> Set oApp = Nothing<br /> End Function<br /> Function ChangeDPBValue(PathToBinFile As String, HASHPassword As String) As String<br /> ''Dim adoStream As ADODB.Stream<br /> ''Dim adoBin As ADODB.Stream<br /> Dim PasswordArrayByte() As Byte<br /> Set adoStream = CreateObject("ADODB.Stream")<br /> Set adoBin = CreateObject("ADODB.Stream")<br /> ReDim PasswordArrayByte(Len(HASHPassword))<br /> ''Convert String to byte<br /> For i = 1 To Len(HASHPassword)<br /> PasswordArrayByte(i) = Asc(Mid(HASHPassword, i, 1))<br /> Next i<br /> ''Read TXT data fine 'DPB' value<br /> With adoStream<br /> .Mode = 3 'adModeReadWrite<br /> .Type = 2 'adTypeText ' adTypeBinary<br /> .Charset = "us-ascii"<br /> .Open<br /> .LoadFromFile (PathToBinFile)<br /> bytes = .ReadText<br /> ''Find Start of Value pos<br /> StartPosVal = InStr(1, bytes, "DPB=", vbTextCompare) + 5<br /> ''IF there is no DPB value<br /> If StartPosVal = 5 Then<br /> .Close<br /> Set adoStream = Nothing<br /> Set adoBin = Nothing<br /> ChangeDPBValue = "VBA Protection Not found"<br /> Exit Function<br /> End If<br /> ''Find End of Value pos<br /> EndPosVal = InStr(StartPosVal, bytes, """", vbTextCompare) - 1<br /> 'Define lenght<br /> ValLength = EndPosVal - StartPosVal + 1<br /> If Len(HASHPassword) < ValLength Then 'add additional '0' if coded password is longer ReDim Preserve PasswordArrayByte(Len(HASHPassword) + ValLength - Len(HASHPassword)) For i = Len(HASHPassword) + 1 To UBound(PasswordArrayByte) PasswordArrayByte(i) = Asc(0) Next i End If .Close End With ''Read binary data With adoStream .Mode = 3 'adModeReadWrite .Type = 1 'adTypeBinary .Open .LoadFromFile (PathToBinFile) ''Create empty stream object With adoBin .Mode = 3 'adModeReadWrite .Type = 1 'adTypeBinary .Open End With 'copy first part of bytes (till start of 'DPB' value) .Position = 0 .CopyTo adoBin, StartPosVal - 1 'copy new DPB value adoBin.Write (PasswordArrayByte) 'copy remaining part of bytes (after 'DPB' value) .Position = EndPosVal ''Set position to remaining part .CopyTo adoBin 'save to file adoBin.SaveToFile PathToBinFile, 2 'adSaveCreateOverWrite adoBin.Close .Close End With Set adoStream = Nothing Set adoBin = Nothing ChangeDPBValue = "" End Function

Jika ada link yang mati harap tinggalkan pesan di kolom komentar.

HALAMAN SELANJUTNYA:

• Tweet
• Share
• Share
• Share
• Share

About Aan Channel

Blog channel yang sekedar ingin berbagi, mohon maah jika terdapat kesamaan isi postingan, hal itu tidak terlepas dari hasil pencarian saat membutuhkan, dan saya share ulang.

Related Post