Using ThisWorkbook.Path

XLS Padlock
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.