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