[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数のPDFファイルにパスワード付きで圧縮する方法』（ストリーム）
複数のpdfファイルにパスワード付きで圧縮する方法を
自動化できないかと思っております。
１つ１つこの作業を行っていると1000ファイルほどあるので
時間がかかってしまいます。
例えば+Lhacaを使用して、複数ファイルにパスワードをかけるとした場合
ExcelのAセルにファイル分のパスワードがあったとします。
PDF格納場所のPDFファイルを
エクセルのAセルにあるパスワードを順番に参照し、それぞれパスワード付けて圧縮できれば、作業効率があがるのですが
なにかサンプルVBAがあると助かります。
また、他にご提案等あればよろしくお願いいたします。
＜ 使用 Excel：Excel2016、使用 OS：unknown ＞
圧縮というのは ZIP のことでしょうか。 EXCEL から7z など（コマンド処理ができるもの）を利用して、簡単にできるかと思いますが、 インストールは可能でしょうか。 https://sevenzip.osdn.jp/ PowerShell の5 以上がある環境でしたら標準機能でもできると思いますが。
（QS） 2020/10/02(金) 09:33
下記2点環境はございますが、パワーシェルはデータ結合等
以前使用したことはございますが、あまり慣れておりません。
PowerShell ver 5.1.18362.752
7zFM.exe
>EXCEL から7z など（コマンド処理ができるもの）を利用して、簡単にできるか と思いますが、 >PowerShell の5 以上がある環境でしたら標準機能でもできると思いますが。
操作手順等分からないのですが
どこかのサイトに、操作手順等ございますでしょうか。
（ストリーム） 2020/10/02(金) 10:03
使用するのはCLI の方なので C:\Program Files\7-Zip のようなパスに 7z.exe というファイルがないでしょうか。
コマンドウィンドウでこれだけ打てば、使用方法が表示されますが、
>7z.exe a -q -pPASSWORD D:\test.zip D:\test.pdf のようにすることでZIPファイルが作成できます。
これを VBAでセル情報を使用しながら処理すれば一括処理になると思いますが、サンプルは後程。 （QS） 2020/10/02(金) 11:41
とりあえず、このマクロを入れたEXCELファイルと同じフォルダ内にZIP化するファイルがある前提です。 そのあたりを変更したい場合は、マクロを変更してください。
A列が処理するファイル名、B列がそのファイルのパスワードです。 存在しないファイル、パスワードが空の時はメッセージが表示されます。
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
（QS） 2020/10/02(金) 15:30
（ストリーム） 2020/10/14(水) 20:11
私は有料のAcrobat持ってないので試せませんが、 下記では連絡すればコード教えてくれるみたいですよ https://www.fastclassinfo.com/entry/vba_pdf_password
幾分古い情報なのでなんとも言えません また、入手した情報はこちらに掲示されない方がよいかもしれないですね
せめてエクセルとかワードをパスワードかけてpdfに変換するなら私でもお手伝いできるのですが、、、
（稲葉） 2020/10/15(木) 06:26
QPDFなるコマンドラインのフリープログラム見つけたので試してみました。 結構使えますね！
実行ファイル https://sourceforge.net/projects/qpdf/files/qpdf/
日本語の使い方 http://pdf-file.nnn2.com/?p=865
テスト方法 プログラムファイルを置く場所（pgPath定数）は自分で指定してください） A列 元のファイルパス B列 パスワード C列 出力先のファイルパス
出力で上書きの方法が見つからなかった（英語が読めなかった）ので、逃げてます。 またディレクトリの有無も確かめてないので、存在しないディレクトリを指定したら、出力されません。 そのあたりはFSOで自分で組んでみてください。
Option Explicit
Sub test()
Dim r As Range
Dim inF As String
Dim opF As String
Dim pw As String
Dim flg As Boolean
Dim msg As String
For Each r In Range("A1:A10")
inF = r.Value
pw = r.Offset(, 1).Value
opF = r.Offset(, 2).Value
flg = True
If inF = "" Then Exit For
If Dir(inF) = "" Then
msg = msg & inF & "のファイルがありません" & vbCrLf
flg = False
ElseIf Dir(opF) <> "" Then
msg = msg & opF & "はすでに存在しています。"
flg = False
End If
If flg = True Then Call SetPWForPDF(pw, inF, opF)
Next r
If msg <> "" Then
MsgBox msg
Else
MsgBox "処理が完了しました"
End If
End Sub
Sub SetPWForPDF(pw As String, InputF As String, OutputF As String, Optional oPW As String = """""")
'実行ファイル--> https://sourceforge.net/projects/qpdf/files/qpdf/
'日本語使い方--> http://pdf-file.nnn2.com/?p=865
Const pgPath As String = """C:\Program Files\qpdf-10.0.1\bin\qpdf.exe """
Dim cmd As String
cmd = pgPath & "--encrypt " & pw & " " & oPW & " 40 -- " & InputF & " " & OutputF
With CreateObject("Wscript.shell")
.Run cmd
End With
End Sub
（稲葉） 2020/10/15(木) 15:11
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.