Save with adding current date to file name @ VBA (WORD only)

SaveAndRename.bas

''' OutputFileName :  hogehoge(*date*-*time**initial*).doc
'''                      eg. hogehoge(20120101-1200dck).doc
Sub SaveAndRename()
    Dim fileNameBody As String ' hogehoge in above example
    Dim newFileName As String
    Dim saveDate As String : saveDate = Format(Date, "yymmdd") 
    Dim saveTime As String : saveTime = Format(Time, "hhmm")
    Dim initial As String : initial = "dck"
    Dim re, mc, m
    
    ' 現在開いているファイル名のうち、()より前の部分だけ抜き出す
    ' ファイル名に()が含まれない場合は、現在のファイル名をそのまま使う
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "([^\(\)]+)\(.+\)"
    If re.test(ActiveDocument.Name) Then
        Set mc = re.Execute(ActiveDocument.Name)
        Set m = mc(0)
        fileNameBody = m.SubMatches(0)
    Else
        fileNameBody = ActiveDocument.Name
    End If
    
    ' 保存するファイル名を作成
    newFileName = fileNameBody & "(" & saveDate & "-" & saveTime & initial &").doc"
    ' 名前をつけて保存する
    ActiveDocument.SaveAs newFileName, FileFormat:=wdFormatDocument
    
    'ステータスバーに保存場所表示
    '※　どこに保存したか分からなくなる場合の対策
    Application.StatusBar = "This file saved in " & ActiveDocument.path
End Sub