Location via proxy:   [ UP ]  
[Report a bug]   [Manage cookies]                
Scribd Logo
Upload

Welcome to Scribd!

  • 171 views

    Generate A Unique Sequential Filename.

    Uploaded by

    Subhasish Patnaik
    This document describes a VBA macro that generates unique sequential filenames. It uses Windows API functions to generate filenames with an incrementing numeric suffix like "filename (1).xls", "filename (2).xls" etc. based on a folder path and base filename provided. The macro fills in any gaps in the numbering if files are deleted. It provides four functions that can generate a unique filename as a string in different ways for ease of use.

    Copyright:

    Attribution Non-Commercial (BY-NC)
    Download as TXT, PDF, TXT or read online from Scribd

    Generate A Unique Sequential Filename.

    Uploaded by

    Subhasish Patnaik
    171 views3 pages
    This document describes a VBA macro that generates unique sequential filenames. It uses Windows API functions to generate filenames with an incrementing numeric suffix like "filename (1).xls", "filename (2).xls" etc. based on a folder path and base filename provided. The macro fills in any gaps in the numbering if files are deleted. It provides four functions that can generate a unique filename as a string in different ways for ease of use.

    Original Description:

    EXCEL VBA

    Original Title

    Generate a Unique Sequential Filename.

    Copyright

    © Attribution Non-Commercial (BY-NC)

    Available Formats

    TXT, PDF, TXT or read online from Scribd

    Did you find this document useful?

    Is this content inappropriate?

    This document describes a VBA macro that generates unique sequential filenames. It uses Windows API functions to generate filenames with an incrementing numeric suffix like "filename (1).xls", "filename (2).xls" etc. based on a folder path and base filename provided. The macro fills in any gaps in the numbering if files are deleted. It provides four functions that can generate a unique filename as a string in different ways for ease of use.

    Copyright:

    Attribution Non-Commercial (BY-NC)
    Download as TXT, PDF, TXT or read online from Scribd
    Download as txt, pdf, or txt
    171 views3 pages

    Generate A Unique Sequential Filename.

    Uploaded by

    Subhasish Patnaik
    This document describes a VBA macro that generates unique sequential filenames. It uses Windows API functions to generate filenames with an incrementing numeric suffix like "filename (1).xls", "filename (2).xls" etc. based on a folder path and base filename provided. The macro fills in any gaps in the numbering if files are deleted. It provides four functions that can generate a unique filename as a string in different ways for ease of use.

    Copyright:

    Attribution Non-Commercial (BY-NC)
    Download as TXT, PDF, TXT or read online from Scribd
    Download as txt, pdf, or txt
    You are on page 1of 3

    Excel Generate a unique sequential filename.

    Ease of Use Intermediate Version tested with 2003 Submitted by: Kenneth Hobs Description: A unique full path with filename is generated from a folder and base filename. N either folder nor filename need exist. If they do, gaps in the sequential filena mes are filled first. Requires v5 of shell32.dll which is included in XP SP2 and Windows Server 2003. It is my Vista x64 as well. Discussion: This concept can be used in any VBA code where one needs to generate a unique fi lename with a prefix or base name. The filenames generated are from a folder nam e and a base filename though neither need exist. e.g. c:\file.xls, c:\file (1).x ls, c:\file (2).xls, etc. Basically, two API's are shown. Four custom functions enable the user to pass the folder name and base filename separately or as one s tring. The concept of this macro is a bit similar to tstav's KB entry to produce a unique suffix for a filename. In the XLS attachment, I have compared this met hod to tstav's method. http://vbaexpress.com/kb/getarticle.php?kb_id=1008 Code: instructions for use Sub Test1() Dim s As String s = fMakeAnotherUnique("", Environ("username") & ".xls", ThisWorkbook.Path) MsgBox s, vbInformation, "MsgBox1: fMakeAnotherUnique()" s = fMakeAnotherUnique("", ThisWorkbook.Name, ThisWorkbook.Path) MsgBox s, vbInformation, "MsgBox2: fMakeAnotherUnique()" End Sub Sub Test2() Dim s As String s = MakeAnotherUnique(ThisWorkbook.Path & "\" & Environ("username") & ".xls" ) MsgBox s, vbInformation, "MsgBox3: MakeAntoherUnique()" s = MakeAnotherUnique(ThisWorkbook.FullName) MsgBox s, vbInformation, "MsgBox4: MakeAntoherUnique()" End Sub Sub Test3() Dim s As String s = fMakeUnique("", Environ("username") & ".xls", ThisWorkbook.Path) MsgBox s, vbInformation, "MsgBox5: fMakeUnique()" s = fMakeUnique("", ThisWorkbook.Name, ThisWorkbook.Path) MsgBox s, vbInformation, "MsgBox6: fMakeUnique()" End Sub Sub Test4() Dim s As String s = MakeUnique(ThisWorkbook.Path & "\" & Environ("username") & ".xls") MsgBox s, vbInformation, "MsgBox7: MakeUnique()" s = MakeUnique(ThisWorkbook.FullName) MsgBox s, vbInformation, "MsgBox8: MakeUnique()" End Sub

    'Put this part below in a separate module. Const Max_Path As String = 260 'http://msdn.microsoft.com/en-us/library/bb776479.aspx Public Declare Function PathYetAnotherMakeUniqueName _ Lib "shell32.dll" _ ( _ ByVal pszUniqueName As String, _ ByVal pszPath As String, _ ByVal pszShort As String, _ ByVal pszFileSpec As String _ ) As Boolean 'http://msdn.microsoft.com/en-us/library/bb776479.aspx Public Declare Function PathMakeUniqueName _ Lib "shell32.dll" _ ( _ ByVal pszUniqueName As String, _ ByVal cchMax As Long, _ ByVal pszTemplate As String, _ ByVal pszLongPlate As String, _ ByVal pszDir As String _ ) As Boolean Function fMakeAnotherUnique(vShortTemplate, vLongTemplate, vFolder) As String 'vFolder can end in trailing backslash or not Dim rc As Boolean, vUniqueName As String, s As String vUniqueName = Space$(Max_Path) rc = PathYetAnotherMakeUniqueName(vUniqueName, StrConv(vFolder, vbUnicode), _ StrConv(vShortTemplate, vbUnicode), StrConv(vLongTemplate, vbUnicode)) If rc Then vUniqueName = StrConv(vUniqueName, vbFromUnicode) fMakeAnotherUnique = vUniqueName End If End Function Function MakeAnotherUnique(filespec As String) As String MakeAnotherUnique = fMakeAnotherUnique("", GetFileName(filespec), GetFolderN ame(filespec)) End Function Function fMakeUnique(vShortTemplate, vLongTemplate, vFolder) As String 'vFolder can end in trailing backslash or not Dim rc As Boolean, vUniqueName As String, s As String vUniqueName = Space$(Max_Path) rc = PathMakeUniqueName(vUniqueName, Max_Path, StrConv(vShortTemplate, vbUni code), _ StrConv(vLongTemplate, vbUnicode), StrConv(vFolder, vbUnicode)) If rc Then vUniqueName = StrConv(vUniqueName, vbFromUnicode) fMakeUnique = vUniqueName End If End Function Function MakeUnique(filespec As String) As String MakeUnique = fMakeUnique("", GetFileName(filespec), GetFolderName(filespec)) End Function Function GetFileName(filespec As String) As String

    Dim p1 As Integer, p2 As Integer p1 = InStrRev(filespec, "\") p2 = Len(filespec) - p1 GetFileName = Mid$(filespec, p1 + 1, p2) End Function Function GetFolderName(filespec As String) As String Dim p1 As Integer p1 = InStrRev(filespec, "\") GetFolderName = Left$(filespec, p1) End Function

    How to use: 1. Open the example XLS file and click each of Test buttons, or: 2. Copy the above code. 3. Open any workbook. 4. Press Alt + F11 to open the Visual Basic Editor (VBE). 5. From the Menu, choose Insert-Module. 6. Paste the code into the right-hand code window. 7. Move the Test1 to Test4 Subs to the end or cut and paste to another Modu le. 8. Close the VBE, save the file if desired. Test the code: 1. Open the example XLS file and click each of Test buttons. 2. Save the file with names like those generated and re-click the Test butt ons. 3. Note how the filenames are generated. 4. After saving the workbook with filenames that have (2).xls , (3).xls, (4 ).xls and such, delete one in the middle and click the Test buttons to note how the next generated name is the one that was deleted. Sample File: PathYetAnotherMakeUniqueName.zip 23.79KB

    You might also like