見出し画像

選択したファイルに一括でパスワードを設定する

出戻りガツオ🐟

水曜日・・・疲れますね。
自分は比較的恵まれた？労働環境なので19時には仕事を終わりにして子どもの面倒を見ているのですが

労働時間が短くても仕事は疲れる。

これある意味真理だなって思いました。そもそも8時間もなんで働くんでしょうね。

画像1

パスワード付き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

お決まりの文言がゾロゾロと・・・もう見飽きたよ、というそこの貴方。正しいですｗ

珍しく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の皆様！仲良くしてください！！！

この記事が気に入ったらサポートをしてみませんか？