Using ThisWorkbook.Path


#1

I am using the following Function with callback to delete extra backups of the user’s data (that was exported to an unprotected .xlsx file). Because it uses the ThisWorkbook.Path, it is not working in the compiled workbook.

I pasted the Function from the manual into a module, but I do not understand how to use the callback. I am not good with VBA and the code below was provided from an Excel forum.

So my questions are:

  1. What do I put in place of DoSomethingWith in the callback,

  2. Where, in my code, do I insert the callback to make it work?

     Sub DeleteBackups()
     'Deletes backup files over qty of 5 using creation date.
    
     Dim fso As Object
     Dim fcount As Object
     Dim collection As New collection
     Dim obj As Variant
     Dim i As Long
    
     Set fso = CreateObject("Scripting.FileSystemObject")
    
     'add each file to a collection
     For Each fcount In fso.GetFolder(ThisWorkbook.Path & "\" & "Backups" & "\").Files
    
     collection.Add fcount
    
     Next fcount
    
     'sort the collection descending using the CreatedDate
     Set collection = SortCollectionDesc(collection)
    
     'kill items from index 6 onwards
     For i = 6 To collection.Count
         Kill collection(i)
     Next i
    
     End Sub
    
         Function SortCollectionDesc(collection As collection)
         'Sort collection descending by datecreated using standard bubble sort
         Dim coll As New collection
    
         Set coll = collection
             Dim i As Long, j As Long
             Dim vTemp As Object
    
    
         'Two loops to bubble sort
        For i = 1 To coll.Count - 1
             For j = i + 1 To coll.Count
                 If coll(i).datecreated < coll(j).datecreated Then
                     'store the lesser item
                    Set vTemp = coll(j)
                     'remove the lesser item
                    coll.Remove j
                     're-add the lesser item before the greater Item
                    coll.Add Item:=vTemp, before:=i
                    Set vTemp = Nothing
                 End If
             Next j
         Next i
    
         Set SortCollectionDesc = coll
    
         End Function

#2

In a module of your workbook, copy and paste this:

Public Function PathToFile(Filename As String) 
Dim XLSPadlock As Object 
On Error GoTo Err 
Set XLSPadlock = Application.COMAddIns("GXLSForm.GXLSFormula").Object 
PathToFile = XLSPadlock.PLEvalVar("EXEPath") & Filename 
Exit Function 
Err: 
PathToFile = "" 
End Function 

Then, modify your code:

Sub DeleteBackups()
 'Deletes backup files over qty of 5 using creation date.

 Dim fso As Object
 Dim fcount As Object
 Dim collection As New collection
 Dim obj As Variant
 Dim i As Long

 Set fso = CreateObject("Scripting.FileSystemObject")

 'add each file to a collection
 For Each fcount In fso.GetFolder(PathToFile("") & "Backups" & "\").Files

 collection.Add fcount

etc.

Note the fso.GetFolder(PathToFile("") & “Backups” & “”).Files modification


#3

Perfect. Thank you. That worked.