[[20201021174645]]　『【VBA】パスワード別送zipファイルの解凍』（かなゑ）　ページの最後に飛ぶ

『【VBA】パスワード別送zipファイルの解凍』（かなゑ）

お世話になります。

メールで送られてくるパスワード別送のzipファイルの解凍を
自動化できたらと思い試行錯誤しております。
(セキュリティ向上の為とは耳にしますが、
　結構解凍作業がめんどくさいんですよね。。。
　そもそもこれって効果あるんですかねえ。。。)

市販のテキストを見たり、ネット上で色々と調べてみましたが
参考になりそうなものが少なく
あっても個人的にかなり難しい内容であまり理解できませんでした。

◆参考にしようと思ったサイト
https://thanaism.com/archives/90

そこで一旦発想を変えていろいろと手探りしているところです。
詳しい方いらっしゃいましたら、お助けください。

<現在考えている方法>　
◆以下1,2はOutlook内のマクロ
1.開いているメールアイテム(zipファイル付)を指定フォルダに保存　→　済
2.Outlookのマクロからエクセルを立ち上げ、
　.Runコード使いエクセルのマクロを起動する。　→　済

◆A,Bはエクセル内のマクロ
A.Outlookのメール本文からパスワードを取り出してエクセルに転記 →　未
　※件名(毎回固定)と日付(今日or最新）で条件指定できたら
　　と思うがこの方法がわからない。
　※パスワードはメール本文の【パスワード】という文字の一段落下に
　　9～11桁の英数字の組み合わせで記載されている。
B.保存したファイルを解凍する。
　その際にA.で取り出したパスワードを入力する。　→　未
　※下記のtestBのコードで動かしたところ
　　コピーの完了％を表示するウィンドウが邪魔をして、
　　パスワードの入力のウィンドウにうまく入力されないようでした。
C.解凍したファイルを元に転記など　→　済

Sub testA()
Dim objOutlook As Outlook.Application
Dim myNamespace As Outlook.Namespace
Dim myInbox As Folder

Set objOutlook = New Outlook.Application
Set myNamespace = objOutlook.GetNamespace("MAPI")
Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)

With ThisWorkbook.Worksheets("Sheet1")

    .Cells(2, 1).Value = myInbox.Items(1).SentOn
    .Cells(2, 2).Value = myInbox.Items(1).Subject
    .Cells(2, 3).Value = myInbox.Items(1).Body
End With

End Sub

Sub testB()

    'ファイルシステムオブジェクトの作成
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    'ファイルオブジェクトの作成
    Dim fileObj As Object

    'シェルオブジェクトの作成
    Dim shellObj As Object
    Set shellObj = CreateObject("Shell.Application")

    Dim zipObj As Variant
    Dim ret As Long

    'パスワードの指定
    Dim strPass As String
    strPass = Range("B2").Value

    'ファイル内の全てのファイルを調べる
    For Each fileObj In FSO.GetFolder("C:\~ ").Files

         '拡張子のチェック
         If FSO.GetextensionName(fileObj) = "zip" Then

            ' 解凍
            Set zipObj = shellObj.Namespace(fileObj.Path).Items
            Application.SendKeys strPass & "{Enter}"
            ret = shellObj.Namespace("C:\~ ").CopyHere(zipObj)

          End If

    Next fileObj

    '後処理
    Set FSO = Nothing
    Set shellObj = Nothing
    Set fileObj = Nothing
    Set zipObj = Nothing

    If ret > 0 Then
        MsgBox "失敗しました。"
    End If

End Sub

＜使用 Excel：Excel2016mac、使用 OS：Windows10 ＞

 そこまで面倒か？
 とも思いますが、OUTLOOKだけで完結したほうがいいのでは？

 コマンドラインで解凍する
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1443793929

 7zip
https://sevenzip.osdn.jp/

 圧縮の例
[[20201002090830]]　『複数のPDFファイルにパスワード付きで圧縮する方磨x（ストリーム）
 QSさんの回答が参考になります。

 Aのプログラムに関しては、自分で文字列を選ぶ　が一番汎用的だと思いますよ。
 送ってくる相手によっても、多種多様な本文ですし、メール送り主も送信者と別のプログラムから送られてくる可能性もあるので。
 送ってくる相手が決まっているなら、ドメインと件名で判断して、パスワードの前に決まった文字列（例えば、PASSWORDなど）を元にパスワードを切り出して、リストに無い場合は自分で指定するなどされてはいかがでしょうか？

（稲葉） 2020/10/22(木) 08:17

https://thanaism.com/archives/121

 参考にしたサイト読んだら、解答部分答えあるじゃん・・・

（稲葉） 2020/10/22(木) 08:27

コメント返信：

[ 一覧(最新更新順) ]

[[20201021174645]] 『【VBA】パスワード別送zipファイルの解凍』（かなゑ） ページの最後に飛ぶ

[[20201021174645]]　『【VBA】パスワード別送zipファイルの解凍』（かなゑ）　ページの最後に飛ぶ