Skip to content

Instantly share code, notes, and snippets.

@toagit toagit/xlsUnlock.vbs
Created Jul 14, 2015

Embed
What would you like to do?
エクセルパスワード解除vbスクリプト
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
You can’t perform that action at this time.