【VBScript】エクセルファイルに自動生成したパスワードを設定し、別エクセルで管理

大事な情報が書き込まれているファイルはパスワードを設定しますね。

しかし、何のパスワードを設定したか忘れてしまっては困ります。

今回は、

ドラッグ＆ドロップで

１．パスワードを自動生成
２.  パスワードを設定してエクセルを保存
３．設定したパスワードを別のエクセルファイルに書き込んで保存

というスクリプトを紹介します。

 

Set objFSO = CreateObject("Scripting.FileSystemObject")

'パスワード保存用のエクセルファイル
strOutputFilePath = "C:\Users\AKIKO\Desktop\簡単メール\パスワード.xlsx"

'パスワードの桁数
passKeta = 8


' ドラッグアンドドロップされたファイルパスを取得
For Each strFilePath In WScript.Arguments
    ' パスワードを自動生成する関数

    ' パスワードを自動生成
    strPassword = GeneratePassword(passKeta)  'パスワードを生成
    
    ' エクセルファイルを開く
    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open(strFilePath)
    
    ' パスワードを設定して保存
    objWorkbook.Password = strPassword
    objWorkbook.Save
    
    ' 別のエクセルにファイルパスとパスワードを保存

    Set objOutputWorkbook = objExcel.Workbooks.Open(strOutputFilePath)
    Set objOutputWorksheet = objOutputWorkbook.Worksheets(1)
    
    ' 一番最後の行を取得
    intLastRow = objOutputWorksheet.Cells(objOutputWorksheet.Rows.Count, 1).End(-4162).Row + 1
    
    ' ファイルパスとパスワードを書き込む
    objOutputWorksheet.Cells(intLastRow, 1).Value = strFilePath
    objOutputWorksheet.Cells(intLastRow, 2).Value = strPassword
    
    ' ファイルを保存して閉じる
    objOutputWorkbook.Save
    objOutputWorkbook.Close
    objWorkbook.Close
    
    ' オブジェクトの参照を解放
    Set objOutputWorksheet = Nothing
    Set objOutputWorkbook = Nothing
    Set objWorkbook = Nothing
    Set objExcel = Nothing
Next

Set objFSO = Nothing
Set objShell = Nothing


    Function GeneratePassword(length)
        Const validChars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
        Dim password, i
        Randomize
        password = ""
        For i = 1 To length
            password = password & Mid(validChars, Int((Len(validChars) * Rnd) + 1), 1)
        Next
        GeneratePassword = password
    End Function