ここから本文です

Excel VBA初心者です。 Data1.csv Data2.csv の二つのcsvファイルを、1つのzi...

アバター

ID非公開さん

2019/6/823:04:38

Excel VBA初心者です。

Data1.csv
Data2.csv
の二つのcsvファイルを、1つのzipファイルに圧縮する方法をご教示いただけないでしょうか ♀️よろしくお願いします。

閲覧数:
43
回答数:
2
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

hot********さん

2019/6/905:18:00

"C:\sample\test1.csv"と"C:\sample\test2.csv"を"C:\sample\test.zip"に圧縮します。

Sub sample()
Dim zipFile As Variant
Dim file1 As Variant
Dim file2 As Variant
zipFile = "C:\sample\test.zip"
file1 = "C:\sample\test1.csv"
file2 = "C:\sample\test2.csv"
Dim sh As Object
Dim fso As Object
Dim ts As Object
Set sh = CreateObject("Shell.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile(zipFile, True)
ts.Write "PK" & Chr(5) & Chr(6) & String(18, 0)
ts.Close
sh.Namespace(zipFile).CopyHere file1
Application.Wait [Now()+"0:0:1"] '1秒待ち
sh.Namespace(zipFile).CopyHere file2
MsgBox "終了"
End Sub

  • hot********さん

    2019/6/1107:55:59

    短くしてみました。

    Sub sample()
    Dim zipFile As Variant
    zipFile = "C:\sample\test.zip"
    CreateObject("Scripting.FileSystemObject").CreateTextFile(zipFile, True).write "PK" & Chr(5) & Chr(6) & String(18, 0)
    With CreateObject("Shell.Application")
    .Namespace(zipFile).CopyHere "C:\sample\test1.csv"
    Do While .Namespace(zipFile).items.Count = 0: DoEvents: Loop
    .Namespace(zipFile).CopyHere "C:\sample\test2.csv"
    End With
    MsgBox "終了"
    End Sub

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

アバター

質問した人からのコメント

2019/6/11 09:46:34

ありがとうございます!

ベストアンサー以外の回答

1〜1件/1件中

Prometheusさん

2019/6/909:26:57

「hot********さん」の考え方を、そのまま「VBScript」にしたものですので、ベストアンサーは、必ず、「hot********さん」にお願いします。

「Windows限定」です。

このプログラムは、これから「zip」化したい「csv」ファイルをプログラムファイルにドラッグ&ドロップ(1つでも、複数でも可)するだけです(プログラムファイルの存在するフォルダ内に結果ファイル(「~.zip」)を作成します)。

ただし、拡張子が「csv」以外のファイルが含まれていると、そのファイルは処理対象外になります(「csv」ファイルだけ「zip」にします)。

これは、うっかり間違ったファイルやフォルダを、いっしょにドラッグ&ドロップした場合に、圧縮しないようにするためです。

3行目の「n = "Data.zip"」で、作成する「zip」ファイルのファイル名を設定していますので、質問者の環境に合わせてください。

以下のプログラムを、メモ帳かテキストエディタに貼り付け、「~.vbs」という名前で保存します。

「~」の部分は、何でもかまいませんが、「.vbs」の部分は、必ず、半角です。

できたプログラムファイル(「~.vbs」ファイル)に、これから「zip」化したい「csv」ファイルをドラッグ&ドロップ(1つでも、複数でも可)するだけです。

最後に「Finished!」と表示しますので、「OK」を押して、終了してください。

Option Explicit
Dim c, f, m, n, i, sa, so, wa
n = "Data.zip"
Set so = CreateObject("Scripting.FileSystemObject")
m = so.GetParentFolderName(WScript.ScriptFullName)
Set wa = WScript.Arguments
Set sa = CreateObject("Shell.Application")
so.CreateTextFile(m & "\" & n, False).Write "PK" & Chr(5) & Chr(6) & String(18, 0)
For i = 0 to wa.Count - 1
If LCase(so.GetExtensionName(wa(i))) = "csv" Then
f = so.GetParentFolderName(wa(i))
With sa.NameSpace(m & "\" & n)
c = .Items().Count
.CopyHere wa(i)
Do While c = .Items().Count
WScript.Sleep 100
Loop
End With
End If
Next
Set sa = Nothing
Set wa = Nothing
Set so = Nothing
MsgBox("Finished!")

あわせて知りたい

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる