Get a unique Workbook Name


Home           Programming       Favorites      

This function will return a unique Workbook Name as a string.

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