セレクトしたセルをファイル名におこす

質問

同じフォームの複数のファイルがあり、セレクトしたセルをファイル名におこします。

Const BeforePath = "C:\Documents and Settings\Administrator\デスクトップ\test"
Const AfterPath = "C:\Documents and Settings\Administrator\デスクトップ\test\変更後\"

Sub FileNameChange()
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

Application.ScreenUpdating = False
Dim fl
For Each fl In fso.GetFolder(BeforePath).Files
If InStr(LCase(fl.Name), ".xls") > 0 Then
With Workbooks.Open(fl.Path)
.SaveAs AfterPath & Range("sheet1!A1") & "-" & Range("sheet1!D5") & ".xls"
.Close
End With
End If
Next
Application.ScreenUpdating = True
End Sub

この時、Ｄ5のセルに入っているのは、ユーザ定義の日付で設定された日付（2011/2/1）です。
このマクロを実行すると、エラーが出ます。
ユーザ定義の日付は拾えないのでしょうか？

回答No.5

Wendy02

この程度の短いコードは、コードだけで問題なく読めますが、本当に解決したのなら良いけれども、どう読んでも、エラーの部分は、日付で発生しても、問題それだけではないと思います。

>同じフォームの複数のファイルがあり、セレクトしたセルをファイル名におこします。

ループしているのに、セルが固定しているようですね、一回きりにともかく、複数のファイルで出来るのですか?上書きされませんか?
　.SaveAs AfterPath & Range("sheet1!A1") & "-" & Range("sheet1!D5") & ".xls"

それと、実際すでに保存しているファイルを別のフォルダにコピーして名前を変えるだけではないでしょうか?

以下は、すでに、同じファイル名がある時は、飛ぶように出来ています。Dirを二重に使えないので、FileExists を利用しています。

Sub FileNameChange2()
　Dim fn As String
　Dim newFn As String
　Dim i As Long
　Dim fso As Object
　Set fso = CreateObject("Scripting.FileSystemObject")
　 Const BeforePath = "C:\Documents and Settings\Administrator\デスクトップ\test"
　 Const AfterPath = "C:\Documents and Settings\Administrator\デスクトップ\test\変更後\"

　i = 1
　fn = Dir(BeforePath & "*.xls", vbNormal)

　Do While fn <> ""
　　On Error Resume Next
　　With Worksheets("Sheet1") 'ActiveBookのシート1
　　　'日付名は、適当に変えてください。
　　　newFn = Format$(.Cells(i, 1).Value, "yymmdd") & "-" & Format$(.Cells(i + 4, 4).Value, "yymmdd") & ".xls"
　　End With
　　On Error GoTo 0
　　If Len(newFn) > 5 Then '名前が取れていることを条件にする
　　　 If fso.FileExists(AfterPath & newFn) = False Then　'コピー先に同名ファイルがないこと
　　　 FileCopy BeforePath & fn, AfterPath & newFn
　　　 i = i + 1 'カウンタ加算
　　　End If
　　End If
　　fn = Dir()
　Loop
　Set fso = Nothing
End Sub

回答No.4

imogasi

日付の行でエラーが出るようだったら、質問のような長いコード全体を質問に書く必要ないのじゃない。
回答者は読むのに苦労するし、焦点がぼやける。、
A1に色んな日付を入れて下記やってみたら判るとおもう。
Format関数で書式を文字列化して整えるのは常識。
Sub TEST01()
MsgBox "AA" & Range("A1")
MsgBox Format(Range("A1"), "ggge年mm月dd日")
MsgBox Format(Range("a1"), "yymmdd")
MsgBox Format(Range("a1"), "eemmdd")
End Sub
２番目は挙げてみただけ。
三番か４番目が６桁でそろい良いのでは。
ーーー
/　￥は不可。ハイフンも、Googleで「ファイル名　ハイフン」で照会すると、フォルダ名、ファイル名で不都合事例が出ているので、場合によっては注意。

お礼

有難うございました。
おかげさまで出来ました。

回答No.3

OrangeCup150

>ユーザ定義の日付は拾えないのでしょうか？
VBAでは日付型として扱われるため（文字列で渡されるわけではないため）、表示書式を変更することに意味はありません。

下のいずれかの方法によって / を取り除いてください。

(A)置換処理 replace(Range("sheet1!D5"), "/","") => 20110205.xls
(B)書式処理 format$(Range("sheet1!D5"), "yyyy年mm月dd日") => 2011年02月05日

お礼

有難うございました。
おかげさまで出来ました。

回答No.2

NNori

ファイル名に / が入るからエラーになってしまうのではないでしょうか。
年月日を/抜きにすればよいかと。

回答No.1

edomin7777

OSもエラーメッセージも書かれていないので想像ですが、
半角の「/」は、ファイル名に使えないけど大丈夫？

補足

Windows Vista
Office2003

実行時エラー1004　と出ます。

確かに、セルの入力は「2011/2/4」で、表示された状態だと「2011年2月4日」となっています。
半角の「/」があるのでファイル名で引っ張れないのですか？

既に大量のファイルがこのように入力されていますが、ファイル名に日付を引っ張ってきたいのですが、どうすればいいのか分かりません。

というか、別にファイル名に引っ張ってこなくても、この大量のファイルに入っている日付を一覧にしたいだけなんですが。

私はテクニックがないので、一旦ファイル名に起こして、ディレクトリ内のファイル名をリストにするツールで一覧を作ろうとしています。