選択したファイルに一括でパスワードを設定する
水曜日・・・疲れますね。
自分は比較的恵まれた?労働環境なので19時には仕事を終わりにして子どもの面倒を見ているのですが
労働時間が短くても仕事は疲れる。
これある意味真理だなって思いました。そもそも8時間もなんで働くんでしょうね。
パスワード付きzip(PPAP)の危険性が訴えられえている昨今で時代に逆行しまくるマクロを今日はご紹介したいと思います。
PPAPってコレじゃないですよ
くだらなすぎますね。失礼しました。本題でございます。
選択したファイルに一括でパスワードを設定する
私の記事ではエクセルファイルをまとめるーとか
扱っていたりしますがそれと同じ要領でエクセルファイル(拡張子.xlsx)の選択したファイルに一括で同じパスワードを設定しよーというものを挙げます。
コードはこちら!
Sub xlsxPasswordSetting()
Dim OpenFiles As Variant
'複数選択可能のダイアログボックスを開く
OpenFiles = Application.GetOpenFilename("Microsoft Excelブック,*.xlsx", MultiSelect:=True)
If IsArray(OpenFiles) = False Then Exit Sub
Dim PasswordString As String: PasswordString = InputBox("設定するパスワードを入力してください", "パスワード設定")
'=============================
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'=============================
Dim i As Integer
'============================================================
'Passwordファイルは不可
If PasswordFileCheck(OpenFiles) <> 0 Then
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
Exit Sub
End If
Application.DisplayAlerts = False
For i = LBound(OpenFiles) To UBound(OpenFiles)
Workbooks.Open FileName:=OpenFiles(i), Password:=vbNullString, UpdateLinks:=False
With ActiveWorkbook
.SaveAs Password:=PasswordString
.Close
End With
Next i
Application.DisplayAlerts = True
'=============================
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
'=============================
MsgBox "Complete", vbInformation, "PasswordSetting"
End Sub
Function PasswordFileCheck(ByVal OpenFiles As Variant) As Integer
Dim i As Integer
On Error Resume Next
Application.DisplayAlerts = False
For i = LBound(OpenFiles) To UBound(OpenFiles)
Workbooks.Open FileName:=OpenFiles(i), Password:=vbNullString, UpdateLinks:=False
If Err.Number <> 0 Then
MsgBox Dir(OpenFiles(i)) & vbNewLine & "パスワード付ファイルです。", vbCritical, " Error"
Exit For
End If
Workbooks(Dir(OpenFiles(i))).Close
Next i
Application.DisplayAlerts = True
PasswordFileCheck = Err.Number
End Function
お決まりの文言がゾロゾロと・・・もう見飽きたよ、というそこの貴方。正しいですw
珍しくFunctionを使っています。私Functionプロシージャ結構好きですよ。値渡しは勉強したのですがどうも偏見があり、基本的に引数にByvalは絶対書いちゃいます。
これ書いておけばとりあえず変数の値が変な動きしないんやな!っていう雑な認識です。
このマクロのダサイところ
このマクロのダサイところは・・・
エクセルファイルを結果的に開いて閉じてを二回やっていること
です。ダサいねー。
Function PasswordFileCheck(ByVal OpenFiles As Variant) As Integer
Dim i As Integer
On Error Resume Next
Application.DisplayAlerts = False
For i = LBound(OpenFiles) To UBound(OpenFiles)
Workbooks.Open FileName:=OpenFiles(i), Password:=vbNullString, UpdateLinks:=False
If Err.Number <> 0 Then
MsgBox Dir(OpenFiles(i)) & vbNewLine & "パスワード付ファイルです。", vbCritical, " Error"
Exit For
End If
Workbooks(Dir(OpenFiles(i))).Close
Next i
Application.DisplayAlerts = True
PasswordFileCheck = Err.Number
End Function
ググったんですけどファイルを開かないでパスワード付のエクセルファイルか調べるうまい方法がなさそうなんですよね。
仕方なく一回開いてエラーなったやつはエラー番号返してPasswordFileCheckという変数にエラー番号入れるやり方をしています・・・。
いい方法あったら教えてください!!!
次回!超手抜き宣言!!!
パスワードを一括で設定となったら今度は一括で●●ですね。
ほんとちょちょちょい。手抜きの手抜きすけっすわ。
余裕っすわ。
流行りものにのるスタイル。あたい仕事で疲れているのよね・・・。
数年前は自分のマクロ力に自信があったのですが今の自分から見返すと鼻くそです。
ダニング=クルーガー効果ってやつですかね。
職場で書くコードもそれっぽくなってきたというか本職っぽさをにおわせても来ていますよ。
一人でやる業務改善よりノウハウの共有のほうが多分組織にとって有益だろうと思うのですがなかなか一歩踏み出せない・・・。ありがた迷惑なんじゃないかと思いますが、私なりのコミュ力を生かして同志を増やして
VBAフレンドを作る!
今年の目標です。そしてVBAerの皆様!仲良くしてください!!!
この記事が気に入ったらサポートをしてみませんか?