Created
July 14, 2015 00:58
-
-
Save toagit/b83d6fb3670045745caa to your computer and use it in GitHub Desktop.
エクセルパスワード解除vbスクリプト
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Option Explicit | |
Dim max | |
Dim min | |
'=============================================================================== | |
':: 最大(max)・最小(min)のパスワード長を設定してください | |
max = 10 | |
min = 3 | |
'=============================================================================== | |
':: ここから下はいぢらないでください | |
Dim i | |
Dim filename | |
Dim objFile | |
Dim objExcel | |
'エクセルオブジェクト生成 | |
Set objExcel = CreateObject("Excel.Application") | |
'解除ファイル選択処理 = 選択するまでループ | |
With objExcel.FileDialog(1) | |
.Title = "パスワードを解除するファイルを選択してください。" | |
.Filters.Add "Excel (*.xls,*.xlsx)", "*.xls;*.xlsx", 1 | |
.AllowMultiSelect = False | |
End With | |
objExcel.DisplayAlerts = False | |
Do While True | |
objExcel.Visible = False | |
If objExcel.FileDialog(1).Show = -1 Then | |
'objExcel.WindowState = 2 | |
For Each objFile In objExcel.FileDialog(1).SelectedItems | |
filename = objFile | |
Next | |
End If | |
objExcel.Visible = False | |
If filename = False Then | |
filename = MsgBox("ファイルを選択してください。", vbCritical + vbOKCancel) | |
If filename = 2 Then | |
Wscript.Quit | |
End If | |
ElseIf InStr(LCase(filename), ".xls") > 0 Then | |
Exit Do | |
Else | |
filename = MsgBox("エクセルファイルを選択してください。", vbCritical + vbOKCancel) | |
If filename = 2 Then | |
Wscript.Quit | |
End If | |
End If | |
Loop | |
'後始末 | |
Set objFile = Nothing | |
Wscript.Echo "解除ファイル : " & filename | |
'解除処理開始 | |
For i = min To max | |
Call passUnlock("", i) | |
Next | |
'後始末 | |
Wscript.Echo "パスワードが見つかりませんでした..." | |
objExcel.Quit | |
Set objExcel = Nothing | |
Wscript.Quit | |
Sub passUnlock(pass, paslen) | |
Dim i | |
Dim p | |
On Error Resume Next | |
If Len(pass) >= paslen Then Exit Sub | |
For i = &H20 To &H7F | |
If Len(pass & Chr(i)) <> paslen Then | |
Call passUnlock(pass & Chr(i), paslen) | |
Else | |
p = Chr(i) | |
Wscript.Echo pass & p | |
Err.Clear | |
objExcel.Workbooks.Open filename, 0, False, 5, pass & p | |
If Err.Number = 0 Then | |
Wscript.Echo "パスワードを解除しました。[ " & pass & p & " ]" & vbCrLf & "必ず何かに書き写してください" | |
filename = MsgBox("パスワードを解除しました。[ " & pass & p & " ]", vbInformation) | |
objExcel.Visible = True | |
Wscript.Quit | |
ElseIf Err.Number <> 1004 Then | |
Wscript.Echo "予期しないエラーが発生しました。[ " & Err.Description & " ]" | |
filename = MsgBox("予期しないエラーが発生しました。[ " & Err.Number & " ] " & Err.Description, vbCritical) | |
objExcel.Quit | |
Set objExcel = Nothing | |
Wscript.Quit | |
End If | |
End If | |
Next | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment