Imports System.IO
Imports System.Reflection.Metadata.Ecma335
Module Program
Sub Main(args As String())
Dim DocumentType As String = "PO"
Dim DocumentNumbers As New List(Of Integer) From {123, 240001, 240010, 240017, 240002, 240003, 240016}
Dim FileTypeSuffix As String = "pdf"
Dim FolderName As String = IO.Path.GetTempPath()
Dim FileName As String = ""
Try
FileName = GetUniqueFileName(FolderName, DocumentType, DocumentNumbers, FileTypeSuffix)
' Make sure we got a valid, creatable file name
File.Create(Path.Combine(FolderName, FileName), 256, FileOptions.DeleteOnClose).Close()
Console.WriteLine(Path.Combine(FolderName, FileName))
Catch ex As Exception
Console.WriteLine(ex.Message)
End Try
Console.ReadLine()
End Sub
''' <summary>
''' Return a unique and meaningful file name
''' </summary>
''' <param name="DocumentType">I description of the types of document in the list. Included in the file name</param>
''' <param name="DocumentNumbers">A list of document numbers</param>
''' <param name="FileTypeSuffix">The suffix for the file name</param>
''' <returns>A unique and meaningful filaname. Could delete an existing file</returns>
Function GetUniqueFileName(FolderName As String, DocumentType As String, DocumentNumbers As List(Of Integer), FileTypeSuffix As String) As String
Dim DocumentNumberRanges As New Dictionary(Of Integer, Integer)()
Dim DocumentNumberRangesAsString As New List(Of String)()
Dim DocumentFormatString As String = "000000"
Dim DateFormatString As String = " yyyy-MM-dd" ' If you want to add time, remember you cannot have colons in file names
Dim MaxDocumentNumbers As Integer = 5
Dim StrictlyEnforceMax As Boolean = False ' When false, this uses the full range if the list ends with a range
Dim DocumentNumberCount As Integer = 0
Dim IsMoreDocuments As Boolean = False
Dim FileName As String = ""
Dim DeleteExistingFile As Boolean = True ' Can we delete an existing file to enforce uniqueness?
Try
DocumentNumberRanges = ConvertListToRanges(DocumentNumbers)
For Each Range As KeyValuePair(Of Integer, Integer) In DocumentNumberRanges
If DocumentNumberCount < MaxDocumentNumbers Then
If Range.Key = Range.Value OrElse (DocumentNumberCount + 2 > MaxDocumentNumbers And StrictlyEnforceMax) Then
DocumentNumberRangesAsString.Add(Range.Key.ToString(DocumentFormatString))
DocumentNumberCount += 1
Else
DocumentNumberRangesAsString.Add($"{Range.Key.ToString(DocumentFormatString)}-{Range.Value.ToString(DocumentFormatString)}")
DocumentNumberCount += 2
End If
Else
IsMoreDocuments = True
End If
Next
FileName = $"{DocumentType} {String.Join(",", DocumentNumberRangesAsString)}{If(IsMoreDocuments, "...", "")}{Date.Now.ToString(DateFormatString)}"
FileName = UniquifyFileName(FolderName, FileName, FileTypeSuffix, DeleteExisting:=DeleteExistingFile)
Return FileName
Catch ex As Exception
Throw New Exception("GetUniqueFileName:" & ex.Message)
End Try
End Function
''' <summary>
''' Convert a random list of values into a sorted list of ranges
''' </summary>
''' <param name="Values">A list of numbers</param>
''' <returns>The list sorted into a list of ranges</returns>
Function ConvertListToRanges(Values As List(Of Integer)) As Dictionary(Of Integer, Integer)
Dim Ranges As New Dictionary(Of Integer, Integer)
Try
Values.Sort()
For Each Value As Integer In Values
If Ranges.Count = 0 OrElse Value <> Ranges.Last().Value + 1 Then
Ranges.Add(Value, Value)
Else
Ranges(Ranges.Last().Key) = Value
End If
Next
Return Ranges
Catch ex As Exception
Throw New Exception("ConvertListToRanges:" & ex.Message)
End Try
End Function
''' <summary>
''' Uniquifies a file name by inserting (Copy n) to avoid conflicting with an existing file
''' </summary>
''' <param name="FileName">The file name with no suffix</param>
''' <param name="FileTypeSuffix">The file suffix</param>
''' <param name="DeleteExisting">Uniquify the file name by deleting the existing file if possible</param>
''' <returns>A unique file name in the form {filename}[ (Copy n)].{suffix}</returns>
Function UniquifyFileName(FolderName As String, FileName As String, FileTypeSuffix As String, DeleteExisting As Boolean) As String
Dim NewFileName As String = $"{FileName}.{FileTypeSuffix}"
Dim CopyNumber As Integer = 0
Dim FileExists As Boolean
Try
Do
FileExists = File.Exists(Path.Combine(FolderName, NewFileName))
If FileExists And DeleteExisting Then
Try
File.Delete(Path.Combine(FolderName, NewFileName))
FileExists = False
Catch ex As Exception
' We could not delete it
End Try
End If
If FileExists Then
CopyNumber += 1
NewFileName = $"{FileName} (Copy {CopyNumber}).{FileTypeSuffix}"
End If
Loop Until Not FileExists
Catch ex As Exception
Throw New Exception("ApplyCopyNumber:" & ex.Message)
End Try
Return NewFileName
End Function
End Module
