ようこそ ゲスト さん、新規登録(無料)して気になる疑問を解決しませんか?

質問

QNo.3997814 Excel VBA 開いているブック名を取得してその名前で保存する方法を教えてください
質問者:mugigohan フォルダから不特定のファイル名「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)"
困り度:
  • 困っています
質問投稿日時:
08/05/04 22:22
この質問に対する回答は締め切られました。

回答良回答10pt

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

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

あと、他の方からも指摘がありましたがタイプミスがあるようですね
VBEで ツール→オプション→編集のタブ 宣言を強要するにチェック
今作っているマクロにはモジュールの一番上に Option Explicit
と書いて、一度コンパイルしてみてください
コンパイルは デバッグ→一番上です
回答者:pulsa
種類:アドバイス
どんな人:専門家
自信:参考意見
回答日時:
08/05/06 01:57
この回答へのお礼Dir関数のこと、色々教えてくださりありがとうございました。Scripting.FileSystemObjectを使ったやり方は今後の課題とさせていただきます。(正直・・・使い方がわからないのでこれから勉強していきます。)

回答良回答20pt

ANo.4 #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
回答者:yukapapa
種類:アドバイス
どんな人:一般人
自信:参考意見
回答日時:
08/05/05 12:51
この回答へのお礼この回答にお礼をつける(質問者のみ)

回答

ANo.3 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) には必ず、”.”を付加すること


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

以上。
 
回答者:onlyrom
種類:回答
どんな人:一般人
自信:自信あり
回答日時:
08/05/05 11:34
この回答へのお礼この回答にお礼をつける(質問者のみ)

回答

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

  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
回答者:yukapapa
種類:回答
どんな人:一般人
自信:参考意見
回答日時:
08/05/05 01:22
この回答へのお礼保存する際のファイル名以外は正常に動いているのでしょうか?
→今の環境では正常に動いていますが・・・・

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

回答

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

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

ActiveWorkbook.SaveAs Filename:="C:\WINDOWS\デスクトップ\空\" & FoundFiles(i)
回答者:hana-hana3
種類:アドバイス
どんな人:一般人
自信:参考意見
回答日時:
08/05/04 22:32
この回答への補足\" & FoundFiles(i)として、試して見ましたが、subまたはファンクションが定義されていませんと出てしまいます。
\" & .FoundFiles(i)とするとフォルダが存在しません。のようなメッセージが出てしまいます。
どうしたら良いものでしょうか?
この回答へのお礼この回答にお礼をつける(質問者のみ)