[[20190814125622]] 『デスクトップにある複数のzipファイルを解凍し、潤x(わわわ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『デスクトップにある複数のzipファイルを解凍し、所定フォルダに格納』(わわわ)

デスクトップ上にダウンロードしたzipファイルが複数あり、
VBAを使い、ファイル解凍およびファイル内エクセルを所定のフォルダに格納出来ればと考えております。
※zipファイルにはパスワード設定は御座いません。

本業務は日次で発生し、
フォルダ内エクセルについても日により格納有無が御座います。

Aフォルダ
┗フォルダ1 …デスクトップ上のzipファイルA内に該当のエクセル1があれば格納
┗フォルダ2 …デスクトップ上のzipファイルA内に該当のエクセル2があれば格納
┗フォルダ3 …デスクトップ上のzipファイルA内に該当のエクセル3があれば格納

Bフォルダ
┗フォルダ1 …デスクトップ上のzipファイルB内に該当のエクセル1があれば格納
┗フォルダ2 …デスクトップ上のzipファイルB内に該当のエクセル2があれば格納
┗フォルダ3 …デスクトップ上のzipファイルB内に該当のエクセル3があれば格納

スキル不足の為、皆様のお力添えを頂けますと幸いです。

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


 フォルダ1とエクセル1
 AフォルダとzipファイルA

 のそれぞれ 1 及び A は意味がありますか?
 つまり、それを判断材料として使用してよいかということです

 また zipファイルに対応するフォルダはすべてそろっているということでしょうか?

 
(渡辺ひかる) 2019/08/14(水) 14:55


渡辺ひかるさん

ご返信ありがとう御座います。

詳しくは、
A/Bフォルダ …会社別
フォルダ1/2/3…拠点別

それぞれのzipファイルに拠点別のエクセルファイルが混在しており、
それを振り分ける為のVBAとなります。
※このzipファイルの中に拠点別のエクセルファイルが入っていたりいなかったりが日次で異なる為、
 何かしらの制御が必要と考えておりました。

ご質問の回答になっていないかもしれませんが、
ご確認よろしくお願い致します。

(わわわ) 2019/08/14(水) 15:32


 とりあえず
 デスクトップからzip ファイルを見つけて解凍し、ファイル名からフォルダを指定して
 (フォルダがなければ作成して)コピーする コードです。
 圧縮ファイルを解凍したフォルダは都度削除しています。
 Excelファイルはxlsx形式に限定してあります。

Sub test1()

    Dim myFso As Object
    Dim mySh As Object
    Dim myFile As Object
    Dim myFile2 As Object
    Dim myPFld As String
    Dim myFld As String
    Dim myPath As Variant
    Dim myTmpFld As Variant

    With CreateObject("WScript.Shell")
        myPath = .SpecialFolders("Desktop")
    End With
    myTmpFld = myPath & "\Tmp"

    Set myFso = CreateObject("Scripting.FileSystemObject")
    Set mySh = CreateObject("Shell.Application")

    With myFso
        For Each myFile In .GetFolder(myPath).Files
            If StrConv(Right(myFile.Name, 3), vbNarrow) = "zip" Then
                '格納先親フォルダ名取得
                myPFld = myPath & "\" & Mid(myFile.Name, Len(myFile.Name) - 4, 1)
                If .FolderExists(myPFld) = False Then .CreateFolder myPFld
                If .FolderExists(myTmpFld) = True Then .DeleteFolder myTmpFld
                .CreateFolder myTmpFld

                mySh.Namespace(myTmpFld).CopyHere mySh.Namespace(myFile.Path).items

                For Each myFile2 In .GetFolder(myTmpFld).Files
                    If StrConv(Right(myFile2.Name, 4), vbNarrow) = "xlsx" Then
                        '格納先フォルダ名取得
                        myFld = myPFld & "\" & Mid(myFile2.Name, Len(myFile2.Name) - 5, 1)
                        If .FolderExists(myFld) = False Then .CreateFolder myFld
                        myFile2.Copy myFld & "\" & myFile2.Name
                    End If
                Next
            End If
        Next
    End With
End Sub

(渡辺ひかる) 2019/08/14(水) 16:29


>渡辺ひかるさん

作成ありがとう御座います。

デスクトップに【A.zip / B.zip】をテストで置き、それぞれに【1.xlsx / 2.xlsx】を格納し、
上記VBAを実行致しましたが、Aフォルダ・Bフォルダ・Tmpフォルダが作成され、
ABともにフォルダ内は空の状態で、TmpフォルダにB.zipの1.xlsx / 2.xlsxが格納

※testフォルダを作成し、VBAエクセルファイルも格納
 同フォルダにAフォルダ・Bフォルダを作成しましたが、
 上記同様の事象が発生

コードを読み解く事が難しい為、
不足している対応が御座いましたらご教授お願い致します。

お手隙の際にご確認よろしくお願い致します。

(わわわ) 2019/08/14(水) 17:01


 最後に
 TmpフォルダにB.zipの1.xlsx / 2.xlsxが格納
 というのは、プログラムの手抜きなので正常です

 こちらでも同じフォルダ、ファイル名で テストしてみましたが
 正常に動きました

 気になるのはZIPを作ってからExcelファイルを格納・・ とありますが

 こちらでは1.xlsx / 2.xlsx を共に選択した状態で、
 右クリック→送る→圧縮(zip形式)フォルダー で zipファイルを作成して います。

 それと、フォルダ名は 拡張子を除いたファイル名の最後の1文字を取り出して
 フォルダを探し、なければ作成しています。

 Excelファイルを Test1.xlsx,Test2.xlsx などとして、実行してみてください

(渡辺ひかる) 2019/08/14(水) 17:20


>渡辺ひかるさん

ご指示通りの圧縮方法で正常に動作致しました。
ありがとう御座います!

※Aというフォルダに該当エクセルを格納し、Lhaplusで圧縮する方法では、
 VBAは正常に動作しないという事でしょうか。
 また、最後の1文字を取り出して、フォルダを探す記述部分について、
 こちらは完全一致という理解で宜しいでしょうか。

最後に、Tmpフォルダが「プログラムの手抜き」と記載頂きましたが、
こちらはTmpフォルダが作成されないようにする事はプログラム上不可となりますでしょうか。

ご依頼・質問が多く申し訳御座いません。
(わわわ) 2019/08/14(水) 17:41


>渡辺ひかるさん

もう1点追加で申し訳御座いません。

ファイル名の最後の1文字を取り出すコード記述について、
ファイル名(曖昧検索)にてファイルを指定する事は可能でしょうか。


・末尾がタイムスタンプだった場合、コードを修正するスキルがない為
・「テストデータ20190814」を「テスト*」等で指定する方がスキルがない中でも汎用性がありそうな為

ご確認よろしくお願い致します。
(わわわ) 2019/08/14(水) 17:56


 外なので、詳細にはかけませんが。
まず、圧縮方法については、質問者さんのやり方だと、
解凍した時にフォルダごと解凍されるので、階層が一つ深くなります。
それでエクセルファイルが見つからず、フォルダも作成されなかった
と言うことでしょう。
これは、実際の仕様に合わせる必要がありますので
解凍したときのフォルダ構成を正確に教えてください。

 あいまい検索については、そう言う心配があったので、
 最初の質問をしたんです。
 書かれた内容ではファイル名とフォルダ名の紐付けがわかりかねます。
 正確にもれなく書いて下さい。
 Tmpフォルダの削除については、コードを一行追加するだけですので、
 書ける環境になったら回答します。

(渡辺ひかる) 2019/08/14(水) 18:39


>渡辺ひかるさん

フォルダ構成について、実務に合わせた定義となると当初のご相談から変更箇所が多くなり、
大変恐縮では御座いますが、下記でご対応可能でしたら改めてお知恵をお借りしたく存じます。

※すべてのファイルをデスクトップへダウンロードした後の作業となります。

ファイル1:order_nnnnnnnnnnnn_yyyymmddhhmmss.zip ※解凍後の命名規則は同様ですが、csvファイル
ファイル2:【社名】●●倉庫_出荷データ作成_mmddhhmmss.csv
ファイル3:【社名】●●倉庫_出荷データ作成_mmddhhmmss.csv ※ファイル2と倉庫名が異なります。
ファイル4:voucher-yyyy-mm-dd-hhmmss-nx-channel30.csv ※channel数は可変
ファイル5:10528_yyyymmddhhmmss.csv
ファイル6:3ple_shipped_list_yyyymmddhhmmss.zip

           ┗解凍後:●●運輸_yyyymmddhhmmss.csv
      ┗解凍後:●●郵便_yyyymmddhhmmss.csv

上記を下記フォルダへ格納
ファイル1:■1_サンプル●●店_出荷リスト取り込み用
ファイル2:■2.1_【●●】出荷データ ※●●は倉庫名
ファイル3:■2.1_【●●】出荷データ ※●●は倉庫名
ファイル4:■3.1_【●●】返却データ ※●●は倉庫名
ファイル5:■3.2_【●●】返却データ ※●●は倉庫名
ファイル6:■4_サンプル●●店_配送完了リスト

※デイリー作業ですが、ファイルが存在しない日もあります。
※ファイル1にはパスワードが掛かっております。

zip解凍の上ファイル移動、csvファイル移動を自動化したく考えております。

何卒ご確認お願い致します。

(わわわ) 2019/08/15(木) 19:11


すみませんが、ほとんど理解できません

最初はデスクトップにzip ファイルが数個ある というのが前提ではないのでしょうか?

なんとか理解しようとしましたけれど

いきなりcsv ファイルが出てきたり・・・

ファイル1はzipファイルのまま■1_サンプル●●店_出荷リスト取り込み用に移動するのですか?

ファイル2,3,4,5は ダウンロードした時点でcsv なのでしょうか?

第三者に説明できるルールにして、説明してください

新入社員に説明するつもりで・・・

それと、解凍後のフォルダ構成が抜けてます。

(渡辺ひかる) 2019/08/15(木) 21:19


 行き違いを防ぐために、追記します。

 私のコードでは、以下の手順を実行しています。

 1.デスクトップからzipファイルを見つけます。
 2.そのzipファイルのファイル名から、解凍後のファイルを保存する会社別のフォルダを特定し、なければ作成します。
 3.解凍用のTmpフォルダがあれば、一旦削除し、新規作成します。
 4.そのzipファイルをTmpフォルダに解凍します。
 5.Tmpフォルダの中を検索して拡張子がxlsxのファイルを見つけます。
 6.5で見つけたファイルのファイル名から、2で特定した会社別フォルダ配下の拠点別のフォルダを特定し、なければ作成します。
 7.5で見つけたファイルを6で特定したフォルダにコピーします。
 8.5に戻り、該当するファイルがなくなるまでループします。
 9.1にもどり、次のzipファイルを見つけます。見つからなかったら終了します。

 私が聞きたいのは

 2のステップでzipファイルのファイル名から、解凍後のファイルを保存する会社別のフォルダを特定する方法
 6のステップで5で見つけたファイルのファイル名から、拠点別のフォルダを特定する方法

 です。

(渡辺ひかる) 2019/08/16(金) 10:06


>渡辺ひかるさん

ご返信ありがとう御座います。
説明に不足があり申し訳御座いません。

>最初はデスクトップにzip ファイルが数個ある というのが前提ではないのでしょうか?
>ファイル2,3,4,5は ダウンロードした時点でcsv なのでしょうか?

⇒前提が覆り申し訳御座いません。
 ダウンロード時点でファイル2,3,4,5はcsvとなります。

>ファイル1はzipファイルのまま■1_サンプル●●店_出荷リスト取り込み用に移動するのですか?

⇒zipファイルを解凍し、解凍後ファイルをフォルダへ格納したいと考えております。

本作業はデイリー対応となりますので、既にそれぞれを格納するフォルダは作成済みとなります。
1.デスクトップからzipファイル(および特定のファイル名csvファイル)を見つけます。

>2のステップでzipファイルのファイル名から、解凍後のファイルを保存する会社別のフォルダを特定する方法

⇒ファイル1は【order_】までが固定の命名規則の為、その部分を判別し、■1_サンプル〜へ格納
 ファイル6は【運輸_/郵便_】までが固定の命名規則の為、その部分を判別し、■4_サンプル〜へ格納

>6のステップで5で見つけたファイルのファイル名から、拠点別のフォルダを特定する方法

⇒ファイル2.3の社名・倉庫名は単一(1種類)となり、フォルダの●●と同一の倉庫名となります。
 ※【社名】AAA倉庫_出荷データ作成_mmddhhmmss.csv を  ■2.1_【AAA】出荷データ フォルダへ
  【社名】BBB倉庫_出荷データ作成_mmddhhmmss.csv を  ■2.1_【BBB】出荷データ フォルダへ

確りとご質問の意図を理解し、回答出来ているか不安ですが、
改めてご確認頂けますと幸いです。

(わわわ) 2019/08/16(金) 10:29


 申し訳ないのですが、まだわかりません

 >ダウンロード時点でファイル2,3,4,5はcsvとなります。

 これは理解しました。zipファイル2つと csv ファイル 4つということですね?

 とりあえずファイル1について

 >⇒ファイル1は【order_】までが固定の命名規則の為、その部分を判別し、■1_サンプル〜へ格納 

 だからどういうルールで「判別」するんでしょう?

 ファイル1の名前は order_nnnnnnnnnnnn_yyyymmddhhmmss.zip 
 解凍後の保存先の親フォルダは、:■1_サンプル●●店_出荷リスト取り込み用 

 order_nnnnnnnnnnnn_yyyymmddhhmmssのなかに●●という情報が含まれているとは思えないのですが・・・

 nnnnnnnnnnnnと●● が一致するということですか?

 それと重要なことですけど

 最初の質問で

 >※zipファイルにはパスワード設定は御座いません。

 とありますが、

 >※ファイル1にはパスワードが掛かっております。

 これでは、私のコードは使えないです。

(渡辺ひかる) 2019/08/16(金) 10:54


>渡辺ひかるさん

最大で、zipファイル2つとcsvファイル4つになります。

ファイル1については、【order*.csv】と判別して、
【■1_サンプル●●店_出荷リスト取り込み用】を指定しファイル移動させる事は難しいでしょうか。

パスワード制御については、
ご相談当初と仕様が変わり大変申し訳御座いません。

複数の処理工程を混在させたコードを思案した方がよろしいでしょうか。
ex)
zipファイルを解凍する(Passあり・なし両方)
デスクトップにあるcsv4つと、解凍後フォルダ内にある該当ファイルを探し、所定フォルダに移動
※すべて上記のように移動させるファイルは曖昧検索として、所定命名規則のフォルダへ移動

想定している挙動がそもそもVBAでは組めない場合、ご指摘ください。
諸所ご説明や仕様に不足があり大変ご迷惑お掛けしております。

(わわわ) 2019/08/16(金) 11:15


 【■1_サンプル●●店_出荷リスト取り込み用】というフォルダは一つしかないのですね?
 私は
 【■1_サンプルAA店_出荷リスト取り込み用】
 【■1_サンプルBB店_出荷リスト取り込み用】
 【■1_サンプルCC店_出荷リスト取り込み用】

 とあるのかと思いました

 とりあえずファイル1の処理です。
 フォルダごと圧縮した想定で階層を深くしてあります。
 パスワードを聞かれると思いますので 入力してください

 Sub test2()

    Dim myFso As Object
    Dim mySh As Object
    Dim myFile As Object
    Dim myFile2 As Object
    Dim myPFld As String
    Dim myFld As String
    Dim myPath As Variant
    Dim myTmpFld As Variant
    Dim myTmpSFld As Object

    With CreateObject("WScript.Shell")
        myPath = .SpecialFolders("Desktop")
    End With
    myTmpFld = myPath & "\Tmp"

    Set myFso = CreateObject("Scripting.FileSystemObject")
    Set mySh = CreateObject("Shell.Application")

    With myFso
        For Each myFile In .GetFolder(myPath).Files
            If StrConv(myFile.Name, vbNarrow) Like "order_*.zip" Then
                '格納先親フォルダ名取得
                myPFld = myPath & "\" & "■1_サンプル●●店_出荷リスト取り込み用"
                If .FolderExists(myPFld) = False Then .CreateFolder myPFld
                If .FolderExists(myTmpFld) = True Then .DeleteFolder myTmpFld
                .CreateFolder myTmpFld

                mySh.Namespace(myTmpFld).CopyHere mySh.Namespace(myFile.Path).items

                DoEvents
                For Each myTmpSFld In .GetFolder(myTmpFld).SubFolders
                    For Each myFile2 In myTmpSFld.Files
                        'If StrConv(Right(myFile2.Name, 4), vbNarrow) = "xlsx" Then
                        If StrConv(Right(myFile2.Name, 3), vbNarrow) = "csv" Then
                            '格納先フォルダ名取得
                            'myFld = myPFld & "\" & Mid(myFile2.Name, Len(myFile2.Name) - 5, 1)
                            myFld = myPFld & "\" & Mid(myFile2.Name, Len(myFile2.Name) - 4, 1)
                            If .FolderExists(myFld) = False Then .CreateFolder myFld
                            myFile2.Copy myFld & "\" & myFile2.Name
                        End If
                    Next
                Next
            End If
        Next
        If .FolderExists(myTmpFld) = True Then .DeleteFolder myTmpFld
    End With

 End Sub

(渡辺ひかる) 2019/08/16(金) 12:34


コメント返信:

[ 一覧(最新更新順) ]


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