セルA1から取ってきた文字列を使ってファイル名にする方法は？

質問

■Ａ１に顧客名を入力しているファイルを、強制的に『顧客名日付.xls』と
保存させる方法はありますか？

　アンケートを、返信してもらったものを集計するのですが、
『ファイル名『顧客名日付.xls』に変えて返信ねがいます』と、お願いしても、
やはり１部そのままで帰ってきたり、思い思いのファイル名で帰ってくるので、
ファイル名の重複で上書きした事もあります、
今では中身を見て『顧客名日付.xls』と手作業で入れなおしています。（T～T）

300件中約70件はファイル名そのままで帰ってくる始末・・・（トホホ）
今後、件数が増えるので、今のうちに解決をしておきたいのですが
ご存知の方、よろしくおねがいします。

回答No.2

nishi6 · ベストアンサー

色々問題点がある質問と思います。

＞Ａ１に顧客名を入力しているファイルを、強制的に『顧客名日付.xls』と保存させる方法
これはマクロを使えば簡単ですが、色々考える必要があります。

マクロを事前にセットして配布する場合、保存するのはアンケートに答える人になる。
　問題点１．ファイルを保存する場所を確定できるか。ネットワークで使用していないか。
　問題点２．マクロを書き込んでアンケート用のBookとして配布してかまわないか。
　問題点３．起動時のマクロありの警告メッセージを理解してもらえるか。
　問題点４．アンケートを書く人が意図しないファイル名になってしまい混乱しないか。

マクロなしで配布する場合（今と同じ）
　問題点５．返信されたBookにマクロを書き込むなら、直接ファイル名を修正したほうが早い。
　問題点６．『顧客名日付.xls』とあるが、A1が『顧客名』で『日付』は何の日付？
　問題点７．A1の『顧客名』が絶対入力されているか。
　問題点８．多数のファイルのファイル名を変更する場合、同一ファイル名にするエラーが起きないか。
　問題点９．シート名を特定する必要があるが、変更されていないか。

などなど、色々考えられます。
アンケート用のBookにマクロを書き込むと、色々問題が発生し大変かもしれません。

以下で、アンケート用Bookとは別に、Book名を一括で変更する専用のBookを作ってみます。
【概要】
　０.アンケート用Bookには何も変更しません。ある意味、ファイル名は何でも良くなります。
　１．返信されてきたBookをどこか、指定のフォルダに集めて保存します。
　　　　（フォルダを指定するマクロを作ることもできますが長くなるのでこうします）
　　　この時点で同名ファイルになってしまうファイルは後で処理します。
　２．新規Bookを用意します。
　　　これに、指定のフォルダを調べ、ファイル名を書き換えるマクロを書き込みます。
　　　　ファイル名を書き換える方法は（マクロではこのようにしています）
　　　　　・"Sheet1"のA1セルの『顧客名』と
　　　　　・Now()で決定される日付を使用する。
　　　　　・日付の形式は『yyyy_mm_dd』とする。（好きに変更して下さい）
　　　　　・同一ファイル名になったら、ファイル名の先頭に『x』をつける。
　　　　　　再度重複すれば『xx』→『xxx』となっていく。
　３．新規Bookでツール→マクロ→Visual Basic Editor でVBE画面に移り、挿入→標準モジュール で
　　　標準モジュールを挿入します。出てきたコードウインドウに下記マクロをコピーして貼り付けます。
　４．Const myFolder の右辺に指定のフォルダ名を登録します。
　　　フォルダ名の最後に『\』は不要です。
　５．シートに戻り、ツール→マクロ→マクロで BookNameChange を実行します。
このBookのSheet1のA1は返信されてきたBookのA1セルの内容を取り出すのに使っています。返信されてきたBookは閉じたままです。

　　　１．ではファイルをコピーして、テストを行ってみてください。

ここから
↓
Sub BookNameChange()
　　Const myFolder = "A:\Folder" '自分で修正して下さい。** 元のファイルの格納フォルダ **

　　Dim myFile As String 'Book名
　　Dim schFile As String '検索したファイル名
　　Dim schBookName As String '検索したファイル名(パスを除く)
　　Dim KokyakuName As String '顧客名
　　Dim saveFileName As String '保存するファイル名

　　myFile = myFolder & "\*.xls"

　　On Error GoTo ErrorHandler '既に同名ファイルがある場合のエラー回避

　　schFile = Dir(myFile)
　　While schFile <> ""
　　　　With Worksheets("Sheet1")
　　　　　　'このシートのA1に該当シートのA1の値を取り出す
　　　　　　.Range("A1") = "='" & myFolder & "\[" & schFile & "]Sheet1'!A1"
　　　　　　If .Range("A1") <> "0" Then
　　　　　　　　KokyakuName = .Range("A1")
　　　　　　Else
　　　　　　　　KokyakuName = ""
　　　　　　End If
　　　　End With
　　　　'新ファイル名
　　　　saveFileName = KokyakuName & Format(Now(), "yyyy_mm_dd") & ".xls"
　　　　'ファイル名を変える
　　　　If schFile <> saveFileName Then
　　　　　　Name myFolder & "\" & schFile As myFolder & "\" & saveFileName
　　　　End If

　　　　schFile = Dir '次のExcelファイル
　　Wend

　　MsgBox "終了しました"
　　Exit Sub

ErrorHandler:
　　If Err = 58 Then '既に同名ファイルがある場合
　　　　'ファイル名の最初に『x』を付加して新ファイル名にする
　　　　saveFileName = "x" & saveFileName
　　　　Resume
　　End If
End Sub

回答No.1

k-family

マクロはおわかりですか。こんな感じでどうでしょうか。

Sub Macro1()
Dim wk, wk2 As String
wk2 = Date
wk2 = Replace(wk2, "/", "-")
wk = "C:\Documents and Settings\user\デスクトップ\" & Cells(1, 1) & wk2 & ".xls"
ActiveWorkbook.SaveAs Filename:=wk
End Sub

マクロの入力方法がわからなければ、その旨お書きください。
「お客様2002-05-21.xls」のファイル名になります。