エクセルVBAでファイルを別で保存する

質問

ファイルA1,A2,・・・A9,b1,b2・・・と百個くらいファイルがあって、
それを別フォルダにひらがなでわかりやすい名前をつけて保存したいです
A1は商品○○、A2は商品▲▲、・・・というような感じです。
月初にこの作業を行っています。
いつもa1～全部そろっているわけではなくA2がなかったり、B5がなかったりいろいろです。
毎月の作業で面倒なので自動化したいのですが
どのようにしたらいいのでしょうか?

1個1個ファイルを開いて、名前をつけて保存する、という作業で組んでみましたが
ファイルがないところでエラーになってしまいました。
また、1個1個ファイルを開いて、保存、という作業を100回位繰り返して書いてみたんですが
もっとスマートな書き方はあるんでしょうか?

よろしくお願いいたします。

回答No.5

papayuka · ベストアンサー

エラーで閉じちゃうのは、強制終了されるって事？
皆さんの回答で問題は無いと思うのですが、、、
原因は別の所にあるのでは？

まずはシンプルな環境でテストしましょう。

１．適当なフォルダを作り、Book1.xls と Book3.xls を置きます。
２．新規ブックに下記のマクロを記述して上記と同じフォルダに
　　保存（必須）します。（ファイル名は Test.xls とする）

'-------------------------------------------------------------
Sub Test_File_Copy()
Dim myPath As String, myFolder As String

　myPath = ThisWorkbook.Path & "\"
　myFolder = myPath & "Temp"

　'コピー格納用のフォルダを作成
　If Dir(myFolder, vbDirectory) = "" Then MkDir myFolder

　For i = 1 To 3
　　If Dir(myPath & Cells(i, 1)) <> "" Then
　　　 FileCopy myPath & Cells(i, 1), _
　　　　　　　myFolder & "\" & Cells(i, 2)
　　End If
　Next i

End Sub
'-------------------------------------------------------------

３．Test.xls の Sheet1に下記のように記述してマクロを実行

Ａ列　　　　　　　Ｂ列
Book1.xls　　　Ren1.xls
Book2.xls　　　Ren2.xls
Book3.xls　　　Ren3.xls

４．正常に行けば、フォルダ内に Temp フォルダが作成され、
　　Book1.xls と Book3.xls が Ren1.xls と Ren3.xls と言う
　　名前で Tempフォルダに格納されます。

上手くいかないようなら、ファイル名 や 既存ソースなどを提示
しましょう。

お礼

早速お答えくださってありがとうございました。
とても丁寧でわかりやすく大変助かりました。
今は家からなので明日、会社にてテストしてみます。
(上のと同じのは今ためしにやってみました。問題なくできました）
何度もありがとうございます。

補足

5番の方の方法で無事解決することができました。
errorの方法もまったく知らなかった方法ですので
これからも使っていこうと思います。
今回のもどうしてエラーが出てしまったのか考えてみようと思っています。

5名様ともご親切に回答くださり、ありがとうございました。
これからもがんばって勉強していきます。
またの機会がございましたらよろしくお願いします。

回答No.4

Zero_0

毎月のファイル名がわかっていて同じようなパターンで変換するのなら、セル上に変換前と変換後のファイル名を書いておいてVBAでセルの読み出し、ファイルのリネームをループで行えばどうですか。
セルA１～　旧ファイル名　　セルB1～新ファイル名
on error goto ErrTap
for i=1 to 100
OrgFileName = cells(i,1)
NewFileName = cells(i,2)
Name OrgFileName As NewFileName
next i
on error goto 0
exit sub
ErrTap:
resume next

あまりにも雑なプログラムですが・・

お礼

丁寧にありがとうございました
とてもわかりやすかったです。
ほとんど同じようにやったのですが
エラー手前までは旨くできました。
前のずらずら長いものよりずっと見栄えがよくなりました。
しかし、エラーのところで処理が終わり、ファイルが
閉じてしまいます。
そのような命令文は一切なかったのですがerrorを使うとこういう事態が起こる事ってあるのでしょうか?

回答No.3

papayuka

#2さんも書かれているように Dir や FileSearch でフォルダ内のファイルを取得して処理すればエラーは回避出来ます。

それよりも

ファイル　A1.xls　→　商品○○.xls
ファイル　A2.xls　→　商品▲▲.xls

と命名するための基礎データが何処にあるのか不明です。
各ファイルを開く事で、決まったセルから「商品○○」や「商品▲▲」を取得出来るのですか？

お礼

errorのやり方でうまくいかないのでフォルダ内の・・・というやり方も考えようと思っています。
ありがとうございました。

補足

説明不足で申し訳ありません
ファイル名はもともとエクセルの中にあって、
エクセルにファイルa1→○○と書いてあります。
forを使って順番にファイルを指定することはできましたが
100個くらいある中で毎月ないものが異なるので
エラーがどうしても出ることになります。

回答No.2

hana-hana3

うまく理解出来ている状態ではありませんが・・・（私）

１．フォルダからファイル一覧（ファイル名）を取得
２．適当な変換テーブルからファイル名を取得
３．ファイルを、取得したファイル名で任意のフォルダにコピー
FileCopy "c:\tmp\OldData.txt", "c:\tmp\NewData.txt"

という手順ではいかがでしょうか？

参考URL：

http://www.officetanaka.net/excel/vba/file/file07.htm

お礼

私がやりたかったことです。
説明不足ですみませんでした。。。
参考URLとても参考になりました。
はじめ私がやろうと思っていた考え方でした。
明日この方法でチャレンジしようと思います。
ありがとうございました。

回答No.1

shkwta

エラーが生じとき、そこを飛ばして次に進むには、On Error GoTo ステートメントを使います。
簡単な例を書きますので、あとは応用してください。

つぎのプログラムは、a1.xls, a2.xls, a3.xls を、別の名前 b1.xls, b2.xls, b3.xls で保存します。
-------------------
Sub ファイル名変更()
　　Dim i As Integer
　　Dim wb As Workbook

　　For i = 1 To 3
　　　　Set wb = Workbooks.Open("C:\data\a" & i & ".xls")
　　　　wb.SaveAs "C:\data\b" & i & ".xls"
　　　　wb.Close False
　　Next
End Sub
---------------------
ところが、たとえば a2.xls が無かったら、そこでエラーとなって止まります。

そこで、つぎのように変えます。
-------------------------
Sub ファイル名変更()
　　Dim i As Integer
　　Dim wb As Workbook

　　On Error GoTo エラー処理

　　For i = 1 To 3
　　　　Set wb = Workbooks.Open("C:\at\a" & i & ".xls")
　　　　wb.SaveAs "C:\at\b" & i & ".xls"
　　　　wb.Close False
次のファイル:
　　Next

Exit Sub

エラー処理:
　　Resume 次のファイル

End Sub
-----------------------
このようにすると、エラーが生じたらそこを飛ばして次に進みます。ただし、エラーの原因は「ファイルが無い」だけでなく、他の原因のエラーでも次に進みますから、それを区別したければさらに工夫が必要です。

なお、プログラムの途中に On Error GoTo 0 と書くと、そこから先で生じたエラーは処理されず、普通にエラーメッセージを出して止まるようにできます。

お礼

丁寧にありがとうございました
とてもわかりやすかったです。
おかげさまでファイルを開くところが旨くできましたが、
エラーのところに来ると、開いたファイルがすべて閉じてしまいます。
そこまではきちんと動作しているようですがエラーのところから先はできていません。
どうしてこうなってしまうのでしょうか?