【エクセルマクロ】先月実施した業務の自動化紹介

Work
2021.08.04

先月実施した業務の自動化を第二弾で紹介をしたいと思います。
オリンピックのおかげで祝日もあり年休消化も相まってあまり営業日で稼働ができなかったので
大した自動化ではないですが痒い所に手が届くようなツールだと思うので気になる方がいれば参考にして下さい。

パスワード付Zipファイル自動的作成ツール

こんな悩みがありました

毎月数十件のPDFファイルをパスワード付Zipファイルを作成してお客様に送付するという作業がありました。

ある時お客様からファイルのパスワードを入れてもファイルが開かないという指摘をもらってまたファイルを作るという

件数が改めて数えてみると結構な件数発生していることがわかりました。

そこでここを自動化して同じ指摘をもらわないように改善しようということで動き出しました。

ツールの使い方はこんな感じ

指定のフォルダ内にパスワード付ZipにしたいPDFファイルを格納してマクロ実行ボタンを押したら
自動的にPDFファイルをパスワード付Zipを作成しPDFファイルは作業済みのフォルダに移動するものを作りました。

マクロの処理ロジックはこんな感じ

  1. 指定のフォルダに拡張子が.pdfのものがあるか確認する
  2. PDFファイルがある場合はファイル数をカウントする
  3. パスワードを生成
  4. PDFファイル以外のファイルがある場合はエラーとして表示して処理を終了
  5. PDFファイルのみであればZipファイルにするファンクションを呼び出し
  6. ZipファイルになったPDFファイルを対応済みのフォルダへ移動
  7. logシートにファイル名と生成したパスワードを記録
  8. 3～7をファイル数分実施

ツールの制約

今回作成したツールではファイル圧縮ソフトは「Lhaplus」か「7zip」がインストールされていることが前提です。

ツールの導入効果

実際にこのツールを使い始めて１か月程度しかたっていないですが、

使ってもらっているメンバーからはとても楽になったとのコメントをもらいました。

実際の使い方としてはお昼休みの前にPDFファイルを入れてボタンをポチってお昼休憩に入るって感じのようです。

昼休憩が終わるとファイルが全部Zip化されて用意されているという具合です。

実際のソースコードって気になる方いればコメントください！

あまりきれいなコードではないので記事記載できるようなレベルのコードがかけるわけではないです。

なので同じ悩みを持っている人がいればぜひコメント欄でソースコードがほしい旨ご連絡ください。

コメントがあればこちらの記事を更新してソースコードを掲載しようと思います。

あくまで自分がわかるレベルのコメントもついているので多少は読めるレベルだと思います。

最後まで読んでいただきありがとうございます。
７月はあまり営業日がなく２の手、３の手の自動化ができなかったのでそこは反省点ですね。
８月は夏休みもありワクチン接種で休みを取ったり年休消化をしたりほぼ仕事をしていないので８月分の紹介はないと思います。

９月にはまた自動化の事例紹介ができるかと思いますのでまた縁があれば記事を読んでいただけると幸いです。

ちなみに過去の自動化事例紹介もありますので記事を読んでいただけますと幸いです。
/https://uratakeblog.com/excel-automation1/

コピペ用ソースコード (2022/1/17更新) 

Sub まとめてZip()

Dim keyword As String
Dim Target_Path() As String
Dim Zip_Path() As String
Dim Variable_part As String
Dim Key As String
Dim lastRow As Long
Dim pdf, zip As String
Dim work_Path As String
Dim fso, fso1, fso2 As Object
Dim nof As Long
Dim pdf_num As Long
Dim pdfName As String
Dim tmp As String
Dim fl As Folder
Dim f As File
Dim i As Long
Dim length As Integer
Dim result_Path As String

work_Path = Worksheets("まとめてZip").Range("C4").Value
result_Path = Worksheets("まとめてZip").Range("C5").Value
pdf = ".pdf"
zip = ".zip"
i = 0

'パスワード作成
Key = Worksheets("まとめてZip").Range("C3").Value
Variable_part = Format(Date, "yyyymmdd")
keyword = Key + Variable_part

'logシートへの記録
lastRow = Worksheets("log").Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets("log").Cells(lastRow, 1) = keyword

'work_Pathの総ファイル数を取得
Set fso = CreateObject("Scripting.FileSystemObject")
nof = fso.GetFolder(work_Path).Files.Count

'work_PathのPDFファイルの数を取得
pdfName = "*" & pdf
tmp = Dir(work_Path & "\" & pdfName)
    Do While tmp <> ""
        pdf_num = pdf_num + 1
        tmp = Dir()
    Loop

'PDF以外のファイルがある場合の警告
If nof > pdf_num then
    MsgBox "PDF以外のファイルを別の場所に移動してから再実行してください"
    Exit Sub
Else 'PDFファイルのみのであった場合の処理
    ReDim Target_Path(pdf_num - 1)
    ReDim Zip_Path(pdf_num - 1)
    Set fso1 = New FileSystemObject
    Set fl = fso.GetFolder(work_Path)
    For Each f In fl.Files
        Target_Path(i) = f.Path
        length = Len(Target_Path(i))
        Zip_Path(i) = Left(Target_Path(i), length - 4) & zip
        Call zipCompression(Target_Path(i), Zip_Path(i), keyword)
        Set fso2 = CreateObject("Scripting.FileSystemObject")
        fso2.MoveFile Target_Path(i), result_Path
        Set fso2 = Nothnig
        i = i + 1
    Next
End If

Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True

MsgBox "全ファイル圧縮が完了しました"

End Sub

Sub zipCompression(targetPath As String, zipPath As String, Optional password As String = "NOT_SET_PASSWORD")
Dim sh As New IWshRuntimeLibrary.WshShell
Dim ex As WshExec
Dim cmd As String

'圧縮ソフト実行ファイルパス
Const EXE_7ZIP As String = "C:\Program Files\7-Zip\7z.exe"
Const EXE_7ZIP_X86 As String = "C:\Program Files (x86)\7-Zip\7z.exe"
Const EXE_LHAPLUS As String = "C:\Program Files\Lhaplus\Lhaplus.exe"
Const EXE_LHAPLUS_X86 As String = "C:\Program Files (x86)\Lhaplus\Lhaplus.exe"

'圧縮ソフトの存在チェック
If Dir(EXE_7ZIP) <> "" Then
    cmd = """" & EXE_7ZIP & """"
ElseIf Dir(EXE_7ZIP_X86) <> "" Then
    cmd = """" & EXE_7ZIP_X86 & """"
ElseIf Dir(EXE_LHAPLUS) <> "" Then
    cmd = """" & EXE_LHAPLUS & """"
ElseIf Dir(EXE_LHAPLUS_X86) <> "" Then
    cmd = """" & EXE_LHAPLUS_X86 & """"
Else
    MsgBox "圧縮に必要なソフトウェアがありません"
    Exit Sub
End If

'コマンド生成
If InStr(cmd, "Lhaplus") <> 0 Then
    cmd = cmd & " /c:zip"
    If password <> "NOT_SET_PASSWORD" Then cmd = cmd & " /p:" & password
    cmd = cmd & " /n:""" & zipPath & """ """ & targetPath & """"
Else
    cmd = cmd & " a"
    If password <> "NOT_SET_PASSWORD" Then cmd = cmd & " -p" & password
    cmd = cmd & " -tzip """ & zipPath & """ """ & targetPath & """"
End If

'コマンド実行
Set ex = sh.Exec("cmd.exe /c """ & cmd & "")

'コマンド失敗時
If(ex.Status = WshFailed) Then
    MsgBox "コマンド実行時エラー"
    Exit Sub
End If

'コマンドの処理完了を待機
Do While (ex.Status = WshRunning)
    DoEvents
Loop

End Sub

コメント

  1. 高御堂　弘幸 より:
    2022-01-17 12:35

    現在、PDFファイルを自動作成しメールも添付ファイルを自動で取り込めるようにしてあるのですがPDFファイルをZIP化する事だけ出来ていません。
    是非、ソースコードを下さい。

    返信
    • uratakeblog より:
      2022-01-17 22:24

      コメントいただきありがとうございます。Uratakeです。
      少しでもお力になればと思いブログに
      コピペ用のソースコードを記載させていただきました。

      返信