VBAが上手く起動しません。

質問

やりたいことは
『日付欄の名前で新規ファイルを作りたい』
『フォルダ内にすでに同じ名前のファイルがあるなら、ファイルを開く』
『フォルダ内にすでに同じ名前のファイルがあり、すでにファイルが開かれていれば何もしない』
なのですがどうしても上手く起動しません。

試したことは、（添付画像を参照しながら読んでください。）
１．「新規ファイルを保存したいフォルダ」の中の既存ファイル名を取得。
２．次にそれを検索用の名前に変換。
３．元データの値を上から順に検索用リスト内に存在するか検索。
４．見つからなければブック作成、「検索値」を名前に付けて保存。
５．見つかれば、開いているか閉じているかを調べる。
６．閉じていたら、ファイルを開く。
７．開いていたら、アクティブにして終了。

打ち込んだコード→追記へ

回答No.2

米沢 栄蔵（@YON56）

質問の趣旨を次の様に理解し、回答します。
<質問の趣旨>
a.作りたいファイル名をZZZ(仮称－日付ファイル作成機)とします。
b.ZZZで行いたいことは、特定のセルA1に任意の日付を入力し(データYYY)、特定のマクロXXXを実行させると、
(1)YYYと同名のファイルが開かれていると、ファイルYYYをアクティブにし、ZZZを保存しないで閉じる。
(2)YYYと同名のファイルが開かれていないときは、特定のフォルダWWW(セルA2に記述)内にファイルYYYが存在するかどうかを調べ、
(3)存在すればファイルYYYを開き、アクティブにし、、ZZZを保存しないで閉じる。
(4)存在しなければ、ファイルZZZをファイルYYYに変身させる。
c.ファイルZZZに(1)～(4)を実行させるマクロを記述する。
<(1)～(4)を実行させるマクロ>
Sub XXX()
Dim A,B
Dim AA,BB,CC
Dim AAA,BBB,CCC,DDD

AA=Range("A1").Value
BB = ActiveWorkbook.Name
A= Workbooks.Count
For B=1 To A
If Workbooks(A - B).Name = AA Then
Workbooks(AA).Activate
Workbooks(BB).Close False
Exit Sub
End If
Next B
CC=Range("A2").Value
Set AAA = CreateObject("Scripting.FileSystemObject")
Set BBB = AAA.GetFolder(CC)
Set CCC = BBB.Files
For Each DDD In CCC
If DDD.Name= AA Then
Workbooks.Open Filename:=DDD.Path
Workbooks(BB).Close False
Exit Sub
End If
Next
ThisWorkbook.SaveAs Filename:=CC & "\" & AA
End Sub

AAのデータの型には、注意が必要です。
また、アクティブにしたファイルのどのシートを選択し、どのセルを選択させるか等々については、
ご自身で決めて下さい。

回答No.1

ki-aaa

試してみて

Sub test()
　　Dim w_book As Workbook
　　Dim yyyymmdd As String
　　Dim i As Long

　　'新しいブックは、このマクロが書いてあるブックと同じフォルダに作る

　　'マクロの書いてあるブックのA1に日付があるとする
　　yyyymmdd = Format(ThisWorkbook.Sheets("Sheet1").Range("A1"), "yyyymmdd")

　　yyyymmdd = yyyymmdd & ".xls" 'xlsはバージョンに合わせる
　　On Error Resume Next
　　　　'すでにファイルが開かれていればアクティブにする
　　　　Set w_book = Workbooks(yyyymmdd)
　　　　If Err.Number = 0 Then
　　　　　　Workbooks(yyyymmdd).Activate
　　　　　　Exit Sub
　　　　End If
　　　　Err.Number = 0

　　　　'フォルダ内にすでに同じ名前のファイルがあるなら、ファイルを開く
　　　　Workbooks.Open Filename:=ThisWorkbook.Path & "\" & yyyymmdd
　　　　If Err.Number = 0 Then
　　　　　　Exit Sub
　　　　End If
　　　　Err.Number = 0

　　　　'日付欄の名前で新規ファイルを作りたい
　　　　Set w_book = Workbooks.Add
　　　　w_book.SaveAs Filename:=ThisWorkbook.Path & "\" & yyyymmdd
　　　　i = ThisWorkbook.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
　　　　ThisWorkbook.Sheets("Sheet1").Range("A" & i + 1) = yyyymmdd
　　On Error GoTo 0

End Sub