VBAで複数のエクセルファイルを自動圧縮
VBAで複数のエクセルファイルを自動圧縮
お世話になります。
以下サイトなどを参考にVBAでエクセルファイルの圧縮をさせようとしています。
ダイアログで圧縮したいファイルを指定して圧縮するところまではできました。
http://oshiete.hmv.co.jp/qa5155002.html
■やりたいこと
特定のフォルダにある複数のファイルを個別に圧縮して、それぞれzipファイルとしたい。
圧縮するファイルを指定するダイアログは出さずに、自動化したい。
■VBAの記述
Dim Filename As String
Dim strArchiveName As String
Dim strCommand As String
Dim RC As Long
Dim hWnd As Long
Dim strOutPut As String * 512
Dim lngSize As Long
Dim strPassWord As String
strPassWord = "pass"
'ハンドル取得
hWnd = FindWindow("XLMANI", Application.Caption)
'★ファイル名取得★
Filename = Application.GetOpenFilename("*.xls(*.xls),*.xls")
If Filename = "False" Then Exit Sub
Filename = Mid$(Filename, InStrRev(Filename, "\") + 1)
strArchiveName = Mid$(Filename, InStrRev(Filename, "\") + 1, InStrRev(Filename, ".") - InStrRev(Filename, "\") - 1) & & ".zip"
strCommand = "-uP " & strPassWord & " " & strArchiveName & " " & Filename
lngSize = Len(strOutPut)
RC = Zip(hWnd, strCommand, strOutPut, lngSize)
■質問
ファイル名を毎回変えて繰り返し処理すればいいと考えてますが、
圧縮するファイルを指定するダイアログを消すことができません。。。
ファイル名を以下のように直接指定しましたが、以下エラーが出てしまいます。
VBAで取得したファイル名で圧縮するような記述の仕方があればご教示いただけると助かります！
'★ファイル名取得★
Filename = Application.GetOpenFilename("*.xls(*.xls),*.xls")
If Filename = "False" Then Exit Sub
↓以下に変更したがエラー
Filename = "C:\" & "test.xls" ←とりあえずファイル名を固定で指定したつもり。。
●イミディエイトに表示されるエラー
zip warning: name not matched: test.xls
zip warning: test.zip not found or empty
![その他([技術者向] コンピューター) イメージ](https://gazo.okwave.jp/okwave/images/related_qa/c205_3_thumbnail_img_sm.png)
お礼
ありがとうございました。