Get a unique Workbook Name 

Function GetUniquekbookName() As String
   Dim strNewFileName As String
   Dim strpath As String
   Dim strLongName As String
   Dim strExt As String
   Dim strFileUniqueID As String
   Dim intFileUniqueID As Integer

   strpath = objExcel.DefaultFilePath
   strExt = ".xls"
   intFileUniqueID = 0

   strNewFileName = Year(Date) & _ 
   Format(Month(Date), "00") & Format(Day(Date), "00")
   strLongName = strpath & "\" & strNewFileName & strExt
   'Add 001, 002, etc. until name is unique.
   Do Until Len(Dir(strLongName)) = 0
      intFileUniqueID = intFileUniqueID + 1
      strLongName = ""
      strFileUniqueID = Format(intFileUniqueID, "000")

      strLongName = strpath & "\" & _ 
      strNewFileName & strFileUniqueID & strExt

   Loop
   GetNewWorkbookName = strLongName

End Function