|
Send path and filename to function, modify filename before extension if not unique in path. Return path and unique filename using VBA.
Optionally specify format for date/time stamp to be added to filename. If unique name needs to be found, code increments a counter and keeps on checking.
Download zipped BAS file that you can import with a function to return path and unique filename using VBA. mod_GetUniqueFilename_s4p.zip
If you have trouble with the downloads, you may need to unblock the ZIP file, aka remove Mark of the Web, before extracting the file. Here are steps to do that: https://msaccessgurus.com/MOTW_Unblock.htm
'module: mod_GetUniqueFilename_s4p '*************** Code Start *************************************************** ' Purpose : return a unique filename from path\file passed ' optional add DateTime format such as yymmdd OR yymmdd_hhnnss ' uses Now if datetime value not specified and format is ' if duplicate found, increment counter according to psFormatNumber, default="00" ' Author : crystal (strive4peace) ' Code List: www.msaccessgurus.com/code.htm ' This code: https://msaccessgurus.com/VBA/Fx_GetUniqueFilename.htm ' LICENSE : ' You may freely use and share this code, but not sell it. ' Keep attribution. Mark your changes. Use at your own risk. '-------------------------------------------------------------------------------- ' GetUniqueFilename_s4p '-------------------------------------------------------------------------------- Function GetUniqueFilename_s4p(psPathFile As String _ ,Optional psFormatDate2Add As String = "" _ ,Optional psFormatNumber As String = "00" _ ,Optional pvDateTime As Variant _ ) As String '240210 s4p, 11, 317, 240726 'return psPathFile if filename is unique ' if not unique, add possible datetime stamp and test again ' if not unique, increment counter on end of filename before extension ' continue incrementing and testing until a unique filename is found 'PARAMETERS ' psPathFile = file to check or add [datetime and] numbers to file name ' psFormatDate2Add: ' if specified, Format(pvDateTime or Now) will be appended to end ' before extension. Automatically delimited with _ ' ie: yymmdd_hhnn ' "" (default) means adding Date/Time is not desired ' instead or in addition to increment number ' psFormatNumber controls format of the incremented number ' 00 can go to 99. After that, numbers are still shown, ' but sorting won't be right, 99 should be enough! ' pvDateTime - date/time to use for naming the file if not unique ' if psFormatDate2Add <> "" ' And you want something other than Now() ' IGNORED if psFormatDate2Add = "" Dim iPos As Integer _ ,iCount As Integer _ ,sPathFileNoExtension As String _ ,sPathFile As String _ ,sExt As String _ ,sResult As String _ ,sDateTime As String _ ,nDateTime As Date 'initalize return value GetUniqueFilename_s4p = "" 'if no file spec passed, then exit If psPathFile = "" Then Exit Function 'see if what was passed is already unique If Not Dir(psPathFile) <> "" Then ',0 vbNormal 'filename is unique GetUniqueFilename_s4p = psPathFile Exit Function End If 'NOT UNIQNUE so filename before extension needs to change 'separate file name from extension ' assume last period begins file extension, if there is one ' to avoid using FSO iPos = InStrRev(psPathFile, ".") If Not iPos > 0 Then 'no extension sExt = "" sPathFileNoExtension = psPathFile Else 'Dot plus Extension sExt = Mid(psPathFile,iPos) sPathFileNoExtension = Left(psPathFile,iPos - 1) End If ' ---- append datetime stamp to filename? sDateTime = "" 'default -- nothing added If psFormatDate2Add <> "" Then 'format specified -- get a date/time If IsMissing(pvDateTime) Then nDateTime = Now() Else 'has value, make sure its a date If IsDate(pvDateTime) Then nDateTime = CDate(pvDateTime) If nDateTime = 0 Then 'assume not valid nDateTime = Now() End If Else nDateTime = Now() End If End If 'date/time string to add sDateTime = Format(nDateTime,psFormatDate2Add) 'add datetime stamp to filename sPathFileNoExtension = sPathFileNoExtension _ & "_" & sDateTime sPathFile = sPathFileNoExtension & sExt 'check file with datetime stamp added If Not Dir(sPathFile) <> "" Then 'filename is unique GetUniqueFilename_s4p = sPathFile Exit Function End If End If '----------------------- add increment counter to Filename 'filename still isn't unique 'increment number at end of FileName before extension (if there is one) iCount = 0 sResult = "keep testing" sPathFile = "" 'reset return value Do While sResult <> "" iCount = iCount + 1 'increment counter sPathFile = sPathFileNoExtension _ & "_" & Format(iCount,psFormatNumber) _ & sExt '----------------------- check file sResult = Dir(sPathFile) Loop GetUniqueFilename_s4p = sPathFile End Function '-------------------------------------------------------------------------------- ' test '-------------------------------------------------------------------------------- Sub testGetUniqueFilename() '240211, 240726 'CLICK HERE 'PRESS F5 to RUN! Dim sPathFile As String '---------------------- change sPathFile and parameters ' sPathFile = "C:\MyPath\Demo\Files\test" 'no extension sPathFile = "C:\MyPath\Demo\Files\test.txt" ' sPathFile = "C:\NonExistingFile.txt" Debug.Print "GetUniqueFilename_s4p: check " & sPathFile ' Debug.Print Space(3); GetUniqueFilename_s4p(sPathFile, "yymmdd_hhmm", "0") ' Debug.Print Space(3); GetUniqueFilename_s4p(sPathFile) ', , "0" ' Debug.Print Space(3); GetUniqueFilename_s4p(sPathFile) Debug.Print Space(3); GetUniqueFilename_s4p(sPathFile, "yymmdd") End Sub '*************** Code End *****************************************************' Code was generated with colors using the free Color Code add-in for Access
Help: Dir function
Help: Date data type
Help: conversion functions
Help: Date/Time data type (Format property)
Help: Number and Currency data types (Format property)
When creating a file and you don't want to replace what's there, this is useful to create a new filename. If the file name needs to unique in the folder, a number will be added to the end of the file name before the extension. Before that, though, if a format code for date and or time is specified, the filename will have the resulting text appended.
Should you choose to include it, the format code you specify for date/time can be general like years, quarters, months, days, including month and day names — or specify down to a second. Format code can be granular down to hours, minutes, and seconds. In any combination you want!
Underscore _ is used in filenames to delimit what is added.
Here's the link for this page in case you want to copy it and share it with someone:
https://msaccessgurus.com/VBA/Fx_GetUniqueFilename.htm
or in old browsers:
http://www.msaccessgurus.com/VBA/Fx_GetUniqueFilename.htm
Let's connect and team-develop your application together. I teach you how to do it yourself. My goal is to empower you.
While we build something great together, I'll pull in code and features from my vast libraries as needed, cutting out lots of development time. I'll give you lots of links to good resources.
When you email me, explain a lot. The more you tell me, the better I can help. Perhaps you don't need me lots, just a path to get started. Depending on where you are and what you want to do, perhaps I can give you some explanation and links to resources to help you on your way.
Email me at training@msAccessGurus
~ crystal
the simplest way is best, but usually the hardest to see