• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:VBAで複数のエクセルファイルを自動圧縮)

VBAで複数のエクセルファイルを自動圧縮する方法

このQ&Aのポイント
  • VBAを使用して複数のエクセルファイルを自動的に圧縮する方法について解説します。
  • 特定のフォルダ内の複数のファイルを個別にzipファイルとして圧縮する方法をVBAで実装する方法を説明します。
  • VBAのGetOpenFilenameメソッドを使用してファイル名を取得し、それを使って指定したファイルを圧縮する処理を行います。

質問者が選んだベストアンサー

  • ベストアンサー
  • DOUGLAS_
  • ベストアンサー率74% (397/534)
回答No.5

#4 DOUGLAS_ です。 >Filename = "\\FileSarver1\aaa\test.xls" #4 の myPath = "D:\hoge\" を myPath = "\\FileSarver1\aaa\" に ChDrive Left(myPath, 1) ChDir myPath の2行を CreateObject("WScript.Shell").CurrentDirectory = myPath に変えてお試しください。

tochou4848
質問者

お礼

ご回答ありがとうございます! 大変助かりました! パスワード部分は以下で出力できましたので 参考までに記載しておきますね。 dim Pass as string Pass = "hoge" strCommand = "-uP " & Pass & " " & strArchiveName & " " & Filename

その他の回答 (5)

  • kmetu
  • ベストアンサー率41% (562/1346)
回答No.6

> Filename = "\\FileSarver1\aaa\test.xls" これで指定は問題ありませんが、元のソースではZIPの操作をするのにフォルダの指定がなく、カレントフォルダで操作するようになっているように見受けられます。 ローカルで上手くいったのはカレントのフォルダがC:\だったのでしょう。 ですので、Filename = "\\FileSarver1\aaa\test.xls"の後ろでカレントフォルダを\\FileSarver1\aaaに指定してやる必要があります。 CreateObject("WScript.Shell").CurrentDirectory = "\\FileSarver1\aaa" の一行を入れてみてください。 蛇足ですが なんども "\\FileSarver1\aaa"をタイプするのはタイプミスする可能性がありますし、後でフォルダを変更したい場合、複数の指定箇所を変更しなくてはいけないので面倒です。 m_CurrentDir="\\FileSarver1\aaa" として Filename = m_CurrentDir & "\test.xls" CreateObject("WScript.Shell").CurrentDirectory = m_CurrentDir のようにしたほうが間違いが少なくなります。

tochou4848
質問者

お礼

ご回答ありがとうございます! とても参考になりました! ありがとうございました!!

  • DOUGLAS_
  • ベストアンサー率74% (397/534)
回答No.4

'【4】サンプルコード Option Explicit Private Declare Function Zip Lib "Zip32j" (ByVal hWnd As Integer, ByVal szCmdLine As String, ByVal szOutPut As String, ByVal dwsize As Integer) As Integer Private Declare Function FindWindow Lib "USER32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Sub testZip() 'Zip32 による圧縮  Dim hWnd As Long  Dim FSO As Object  Dim myPath As String ' Dim strPassWord As String  Dim Filename As String  Dim strArchiveName As String  Dim strCommand As String  Dim strOutPut As String * 512  Dim lngSize As Long  Dim RC As Long 'ハンドル取得  hWnd = FindWindow("XLMANI", Application.Caption)  Set FSO = CreateObject("Scripting.FileSystemObject") ' strPassWord = "pass"  myPath = "D:\hoge\"  ChDrive Left(myPath, 1)  ChDir myPath 'ファイル名取得  Filename = Dir(myPath & "*.xls")  Do While Filename <> ""   strArchiveName = """" & FSO.GetBaseName(Filename) & ".zip"""   strCommand = "-u " & strArchiveName & " """ & Filename & """"   lngSize = Len(strOutPut)   RC = Zip(hWnd, strCommand, strOutPut, lngSize)   Debug.Print strOutPut   Filename = Dir  Loop  Set FSO = Nothing End Sub

tochou4848
質問者

お礼

ご回答ありがとうございます! できました!! 大変たすかりました!!!

  • DOUGLAS_
  • ベストアンサー率74% (397/534)
回答No.3

#1 DOUGLAS_ です。 #長くなりましたので、2つに分けて投稿いたします。  じっくりと、問題を拝見いたしました。 【1】先ず、余談ですが... http://okwave.jp/qa/q5155002.html #2 さんが書いていらっしゃるように >hWnd = FindWindow("XLMANI", Application.Caption) の "XLMANI" は "XLMAIN" ではないのかなと思って直してみると、 >実行時エラー '6': >オーバーフローしました。 と怒られてしまいます。  これは、"ZIP32J.DLL" を参照する Declare ステートメント 内での エイリアス? の型と、Dim ステートメント で宣言している対応する変数の型とが異なっているからかと存じます。  「Function Zip」の Declare ステートメント 内の「Integer」を全て「Long」に書き換えれば問題なさそうです。 #ところが、WEBサーフィン してみると、「hWnd は 0 でよい」というような記述もありますので、この辺りはそのままでも問題ないのかなとも存じます。従って、『余談です』と書いた次第ですが、そういう経緯で、下記の サンプルコード でも、この部分はそのままにしました。 【2】さて、本題に入りますが。。。 http://okwave.jp/qa/q2405614.html #3 さんがお示しの コード を実行してみると、何も問題なく 圧縮ファイル が作成されるのですが、 Filename = ~~ として、直接、ファイル名 を指定すると不具合が発生する『場合もある』ようです。  Filename = Application.GetOpenFilename( ~~ となっているところが ミソ かなと思って、GetOpenFilename メソッド の ヘルプ を覗いてみました。  バッチリです!! >このメソッドを実行することによって、 >カレント ドライブやカレント フォルダが変更される可能性があります。 と出ています。これですね!!  そこで、 ChDrive Left(myPath, 1) ChDir myPath で「カレント ドライブやカレント フォルダ」を変更してやると OK でした。 【3】次に strCommand = "-uP " & strPassWord ~~ の件ですが、先ず、行の最後の「& &」は「&」ですね。  それはさておき、ダウンロード した ファイル の中から、「ZIP32J.DLL\zip32j\SDK\CMD_ZIP.TXT」を見てみると、 >-P password 暗号化する。 >-u 書庫にファイルを追加・更新する。 となっているのですが、どうも、オプションスイッチ の指定の仕方が解りません。  tochou4848 さんがお書きのように、 strCommand = "-uP " & strPassWord & " " & strArchiveName & " " & Filename としても、圧縮フォルダ はできますが、中身が空っぽです。  この件につきましては、随分とあっちこっち WEBサーフィン してみましたが、原因が解りませんので、今回は「-P」オプション 抜きで サンプルコード をお示しいたします。  なお、「strArchiveName」・「Filename」の双方を ダブルクォーテーション で括った方がよいかと存じまして、そのような コーディング にしております。

tochou4848
質問者

お礼

ご回答ありがとうございます! できました!! 大変たすかりました!!!

  • kmetu
  • ベストアンサー率41% (562/1346)
回答No.2

C:\test.xlsは存在するんですよね。

tochou4848
質問者

お礼

ご回答ありがとうございます。 > C:\test.xlsは存在するんですよね。 はい、ファイルは存在してます。 サンプルデータも登録してます。

tochou4848
質問者

補足

大変申し訳ございません。 ファイルネームが違いました。。 ローカルではうまくいきました。 今度は、ネットワーク上のファイルサーバー上のファイルを指定するとうまくいかないので、 指定の方法が間違っているのだと思いますが、以下のように記述していますが、 どこの記述がまずいかおわかりになりますでしょうか? Filename = "\\FileSarver1\aaa\test.xls"

  • DOUGLAS_
  • ベストアンサー率74% (397/534)
回答No.1

 どうも、ご質問内容がややこしそうですので、 >特定のフォルダにある複数のファイルを個別に圧縮して、それぞれzipファイルとしたい。 >圧縮するファイルを指定するダイアログは出さずに、自動化したい。 という部分についてのみ、ヒント を一つお示しいたします。 [Dir 関数] の ヘルプ をご覧ください。 Sub test()  Dim FSO As Object  Dim myPath As String  Dim Filename As String  Set FSO = CreateObject("Scripting.FileSystemObject")  myPath = "D:\hoge\*.xls" '(A)+(B)を取得  Filename = Dir(myPath)  Do While Filename <> "" '(A)「拡張子」を除いた「ファイル名」を取得   Debug.Print FSO.GetBaseName(Filename) '(B)「拡張子」を取得   Debug.Print FSO.GetExtensionName(Filename) '(A)+「".zip"」を取得   Debug.Print Left(Filename, Len(Filename) - 4) & ".zip" 'ファイル名 に "xls" が含まれていないことが確かであれば、下記でもOK   Debug.Print Replace(Filename, "xls", "zip")   Filename = Dir  Loop  Set FSO = Nothing End Sub

関連するQ&A

専門家に質問してみよう