Excelファイルのあるフォルダに任意のフォルダと日付のフォルダを作成してワークブックの名前に日付_時間を付けてファイルコピー

＜分類：ファイル作成＞
＜使用例：Excelファイルのあるフォルダに任意backup￥日付フォルダを作成してワークブックの名前に日付_時間を付けてファイルコピーする＞
＜プログラム例＞

Sub 使用例()
   Dim s As String
   Dim rtn As String

  '作成するフォルダ名
   s = "backup"

   Call Excelファイルのあるフォルダに任意のフォルダと日付のフォルダを作成してワークブックの名前に日付_時間を付けてファイルコピー(s, rtn)

   MsgBox (rtn & "という名前でこのワークブックのバックアップを作成しました")

End Sub


Sub Excelファイルのあるフォルダに任意のフォルダと日付のフォルダを作成してワークブックの名前に日付_時間を付けてファイルコピー(p1, r1)

'p1:任意のフォルダ名
'r1:作成した任意のフォルダ￥日付のフォルダ\日付・時間のファイルパスを設定

    Dim cfolder_path1 As String
    Dim cfolder_path2 As String
    Dim cfile_path As String
    
    Dim aFso As Object
    Set aFso = CreateObject("Scripting.FileSystemObject")
    
   '任意のフォルダのフォルダパスを設定
    cfolder_path1 = ThisWorkbook.Path & "\" & p1
   '任意のフォルダ￥日付のフォルダパスを設定
    cfolder_path2 = cfolder_path1 & "\" & Format(Now, "yyyymmdd")
   
   'フォルダの存在確認
    If aFso.FolderExists(cfolder_path1) Then
      '作成しようとしたフォルダはすでに存在している
       If aFso.FolderExists(cfolder_path2) Then
         '作成しようとした日付・時間のフォルダはすでに存在している
       Else
          aFso.CreateFolder (cfolder_path2)
       End If
    Else
      '作成しようとしたフォルダは存在しないので作成する
       aFso.CreateFolder (cfolder_path1)
       aFso.CreateFolder (cfolder_path2)
    End If
    
    cfile_path = cfolder_path2 & "\" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ThisWorkbook.Name
    
    
   'ワークブックこのファイルを保存する
    ThisWorkbook.Save
   '保存の確認をしないようにする
    ThisWorkbook.Saved = True
    
    aFso.CopyFile ThisWorkbook.Path & "\" & ThisWorkbook.Name, cfile_path
    
   'r1:リターン値を設定
    r1 = cfile_path
    
End Sub