[[20221202095302]] 『複数のファイル(イエローフォルダ)にユニークパス』(パック) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) |

| 全文検索 | 過去ログ ]

 

『複数のファイル(イエローフォルダ)にユニークパスワードを設定する方法』(パック)

下記のコードで

Aセル Bセル

1.pdf asfty
2.pdf rthui
3.pdf certy

現在格納ファイルの中身

実行前
1.pdf
2.pdf
3.pdf
合計3ファイル

実行後
1.pdf
2.pdf
3.pdf
1.zip(パスワード付)
2.zip(パスワード付)
3.zip(パスワード付)
合計6ファイル

pdf→3ファイル
zipファイル→3ファイル(パスワード付与付)
出来るのですが
pdfに直接パスワードをかけるのではなく
(イエローフォルダ)に直接パスワードをかけたいのですが
フリーソフトを検索してもみつかりません。
出来れば7zipに対応している
暗号化方式 AES-256で対応したいのですが
アドバイスいただけたら助かります。


希望格納ファイルの中身

実行前
1(イエローフォルダ)
2(イエローフォルダ)
3(イエローフォルダ)
合計3ファイル

Aセル Bセル

1   asfty
2   rthui
3   certy

実行後
1(イエローフォルダ)
2(イエローフォルダ)
3(イエローフォルダ)
1.zip(パスワード付)
2.zip(パスワード付)
3.zip(パスワード付)
合計6ファイル

Option Explicit

 Public Const zipCom = "C:\Program Files\7-Zip\7z.exe"
 Public wsh
 Public fso As Scripting.FileSystemObject

 Sub MakeZIPFiles()
    Dim srcWS As Worksheet
    Set srcWS = ActiveSheet

    Set wsh = CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim lastRow
    lastRow = srcWS.Cells(Rows.Count, "A").End(xlUp).Row

    Dim r
    Dim srcPath
    For r = 1 To lastRow
        srcPath = ThisWorkbook.Path & "\" & srcWS.Cells(r, "A").Value
        makeZipFile srcPath, srcWS.Cells(r, "B").Value
    Next
    MsgBox "処理が完了しました。"
End Sub

Sub makeZipFile(srcPath, passWord)

    If fso.FileExists(srcPath) = False Then
        If MsgBox(srcPath & "がありません。" & vbNewLine & "処理を続けますか?", vbYesNo) = vbNo Then End
        Exit Sub
    End If

    If passWord = "" Then
        If MsgBox(fso.GetFile(srcPath).Name & "のパスワードがありません。" & vbNewLine & "処理を続けますか?", vbYesNo) = vbNo Then End
        Exit Sub
    End If

    Dim com
    com = """" & zipCom & """ a -y -p" & passWord & " """ & Replace(srcPath, fso.GetExtensionName(srcPath), "zip") & """ """ & srcPath & """"
    wsh.Run com, 0, True
 End Sub

< 使用 Excel:Excel2016、使用 OS:Windows10 >


>>フリーソフトを検索してもみつかりません。
ひばら さん の
アタッシュケース
は、試されましたですか。^^
他の事は???w、私の理解を高く超えています。
ごめん下さいませ。でわ、お知らせまで。m(__)m
(隠居Z) 2022/12/02(金) 10:23:23

 Sub makeZipFile は FileExistsとかGetFileとか、ファイルにしか対応してないので、
 フォルダに対応するようにすればいいのでは?
(´・ω・`) 2022/12/02(金) 10:29:43

(´・ω・`)様
返信ありがとうございます。
>フォルダに対応するようにすればいいのでは?
フォルダに対応にするために
考慮しているのですが
現状分からなくで困ってます。
(パック) 2022/12/02(金) 10:46:39

(隠居Z)様
ご連絡ありがとうございます。
別件でアタッシュケースは使用してますが
大量のユニークキーを設定できるか調べてみますが
現状方法が分かりません。
(パック) 2022/12/02(金) 10:48:55

 テスtしてないですけど、雰囲気だけ見てください

 Sub makeZipFile(srcPath, passWord)
    If FSO.FolderExists(srcPath) = False Then
        If MsgBox(srcPath & "がありません。" & vbNewLine & "処理を続けますか?", vbYesNo) = vbNo Then End
        Exit Sub
    End If
    If passWord = "" Then
        If MsgBox(FSO.GetFolder(srcPath).Name & "のパスワードがありません。" & vbNewLine & "処理を続けますか?", vbYesNo) = vbNo Then End
        Exit Sub
    End If
    Dim com
    com = """" & zipCom & """ a -y -p" & passWord & " """ & srcPath & "zip" & """ """ & srcPath & """"
    wsh.Run com, 0, True
 End Sub
(´・ω・`) 2022/12/02(金) 11:09:17

助かります。参考にさせて頂きます。どうもありがとうございました。
(パック) 2022/12/02(金) 18:14:07

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.