Excel VBA 開いているブック名を取得してその名前で保存する方法を教えてください

質問

フォルダから不特定のファイル名「FoundFiles(i)」を取得してそのブックを開きます。セルA1が空の場合は、開いた場所と異なるフォルダにそのブックを保存させたいと、なんとか、かんとか作ってみたのですが、保存したファイル名がFoundFiles(i).csvになってしまいます。
もともとcsvを読み込んでいるので、拡張子はcsvで良いのですが、その開いたブック名を取得する方法を教えてください。
いろいろ考えて、変えては見たのですがうまくいきません。
使用しているオフィスはExcel2000です。宜しくお願いします。

↓前後は省略していますが、こんな感じです。

Workbooks.Open Filename:=.FoundFiles(i)
Select Case ThisWorkbooks
Case Range("A1") = ""
ActiveWorkbook.SaveAs Filename:="C:\WINDOWS\デスクトップ\空\FoundFiles(i)"

回答No.4

yukapapa · ベストアンサー

#2です。

.FoundFiles(i) からファイル名を取り出すなら DIR関数でも良いかと思います。

ActiveWorkbook.SaveAs Filename:="C:\WINDOWS\デスクトップ\空\" & Dir(.FoundFiles(i))

ちなみに FileSearch は問題ありありでOSが変わった時とかに結構苦労しました。
http://support.microsoft.com/kb/259738/ja
http://support.microsoft.com/kb/305342/ja
http://support.microsoft.com/kb/920229/ja

回答No.5

pulsa

補足の補足みたくなりますが
Dir関数にも実は困ったバグがあります
http://officetanaka.net/excel/vba/tips/tips69.htm

で、確実なのは、Scripting.FileSystemObjectを使って自作するのが確実です
後はFor Eachで、そのFilesをぐるぐるまわして行けば、ファイル名でも拡張子でも、好きに調べられます

あと、他の方からも指摘がありましたがタイプミスがあるようですね
VBEで　ツール→オプション→編集のタブ　宣言を強要するにチェック
今作っているマクロにはモジュールの一番上に　Option Explicit
と書いて、一度コンパイルしてみてください
コンパイルは　デバッグ→一番上です

お礼

Dir関数のこと、色々教えてくださりありがとうございました。Scripting.FileSystemObjectを使ったやり方は今後の課題とさせていただきます。（正直・・・使い方がわからないのでこれから勉強していきます。）

回答No.3

onlyrom

No2の回答にもあるように提示のコードは質問の件云々以前の問題もあるように思えますが
それなりに動作しているということは、たぶんタイプミスなのでしょう。

で、本題。

原因は.FoundFiles(i)にはファイル名だけではなく、パス名も入っているからです。
ですから別フォルダーに保存したいときは、その中からファイル名だけ取り出す必要があります。

ファイル名取り出しの部分だけかくと以下のようになります。

'------使用変数--------------------------------

　Dim myFullPath As String
　Dim myFileName As String
　Dim S As String

'---------　ファイル名取り出し　----------------

　myFullPath = .FoundFiles(i)
　S = StrReverse(myFullPath)
　myFileName = Right(myFullPath, InStr(S, "\") - 1)

'----------------------------------------------------

取り出したあと、

ActiveWorkbook.SaveAs Filename:="C:\WINDOWS\デスクトップ\空\" & myFileName

とすればいいわけです。

　.FoundFiles(i)　には必ず、”．”を付加すること

老婆心ながら一言。
寄せられた回答をサクサクと修正できるスキルがある場合は別として、
そうでない場合は、前後を省略することなくそこら辺りのコードをある程度は提示した方がいいと思いますよ。
なぜなら、提示の部分ではなくその省略した部分に原因があるかも知れないからです。

以上。

回答No.2

yukapapa

省略されていて良く解りませんけど、保存する際のファイル名以外は正常に動いているのでしょうか？

　　Select Case ThisWorkbooks
　　Case Range("A1") = ""
　　ActiveWorkbook.SaveAs Filename:="C:\WINDOWS\デスクトップ\空\FoundFiles(i)"

この Case を正常に抜けて保存されているならば不思議です。
ThisWorkbook(s)←なんてありませんし、、、

　　Select Case ActiveWorkbook.Worksheets(1).Range("A1").Value
　　Case ""
　　ActiveWorkbook.SaveAs Filename:="C:\WINDOWS\デスクトップ\空\FoundFiles(i)"

ならまだ納得も出来ますけど。

---

こういったケースは Open 時に変数に入れてやるとアクティブか否かに関係なく操作できるので便利です。
あと、FileSearch は難ありで個人的に苦労しましたので DIR を使ったサンプルを載せておきます。
エラー処理はしてません。（指定した移動先フォルダが無いなど）

Sub Test()
Dim fName As String, cfName As String
Dim wb As Workbook, flg As Boolean

　　fName = Dir("C:\Work\*.csv")
　　Do While fName <> ""
　　　　fName = "C:\Work\" & fName　 '移動元のフルパス
　　　　Set wb = Workbooks.Open(fName)
　　　　cfName = "C:\空\" & wb.Name　'移動先のフルパス
　　　　flg = (wb.Worksheets(1).Range("A1").Value = "")
　　　　wb.Close
　　　　If flg Then Name fName As cfName
　　　　fName = Dir()
　　Loop

End Sub

お礼

保存する際のファイル名以外は正常に動いているのでしょうか？
→今の環境では正常に動いていますが・・・・

DIR を使ったサンプルありがとうございました。
こちらのやり方で作り直してみます。
FileSearch を使ったやり方は問題が多いと皆様から教えていただき本当に勉強になりました。
今まで簡単なものしかつくっていなかったので、今回は大苦戦でした。
まだまだ問題山積ですがあちこち調べながらつくって行きたいとおもいます。
本当にありがとうございました。

回答No.1

hana-hana3

＞ActiveWorkbook.SaveAs Filename:="C:\WINDOWS\デスクトップ\空\FoundFiles(i)"

変数名を "" で囲ってしまえば文字列ですから、実行結果は正常です。

ActiveWorkbook.SaveAs Filename:="C:\WINDOWS\デスクトップ\空\" & FoundFiles(i)

補足

\" & FoundFiles(i)として、試して見ましたが、subまたはファンクションが定義されていませんと出てしまいます。
\" & .FoundFiles(i)とするとフォルダが存在しません。のようなメッセージが出てしまいます。
どうしたら良いものでしょうか？