Dim cel As Range

Dim rootFld As String

Dim outFld As String

Dim ts As TextStream

Public Const TemporaryFolder = 2

Public Sub listFiles()

    Dim fso  As New FileSystemObject

    Dim fld As Folder

    Dim ret As String

    

    rootFld = "C:\work\Demo_x86"

    outFld = "E:\Documents\backup"

    ret = runCmd("pushd " & outFld & " " & Chr(38) & " rd /S /Q . 2> nul ")

    

    Set ts = fso.OpenTextFile(outFld & "\cablist.txt", ForWriting, True)

    ts.WriteLine ".OPTION EXPLICIT"

    ts.WriteLine ".Set SourceDir = " & rootFld

    'ts.WriteLine ".Set DestinationDir=" & outFld

    ts.WriteLine ".Set CabinetNameTemplate=" & fso.GetFileName(rootFld) & ".CAB"

    ts.WriteLine ".Set Cabinet=on"

    ts.WriteLine ".Set Compress=on"

    'ts.WriteLine ".Set MaxCabinetSize=2000000000000"

    'ts.WriteLine ".Set MaxDiskSize=512000000"

    Set cel = ActiveCell

    Set fld = fso.GetFolder(rootFld)

    Call listFld(fld)

    ts.Close

    

    ret = runCmd("pushd " & outFld & " " & Chr(38) & " makecab /F " & """" & outFld & "\cablist.txt" & """ /L " & outFld)

    Debug.Print ret

End Sub

Public Sub listFld(fld As Folder)

    Dim subFld As Object

    Dim f As Object

    For Each f In fld.Files

        'Debug.Print f.name

        cel.Value = Mid(f.Path, Len(rootFld) + 2, 100)

        Set cel = cel.Offset(1, 0)

        ts.WriteLine """" & Mid(f.Path, Len(rootFld) + 2, 100) & """"

    Next

    For Each subFld In fld.SubFolders

        'Debug.Print subFld.name

        'cel.Value = Mid(subFld.Path, Len(rootFold) + 1, 100)

        'Set cel = cel.Offset(1, 0)

        ts.WriteLine ".Set DestinationDir=" & """" & Mid(subFld.Path, Len(rootFld) + 2, 100) & """"

        Call listFld(subFld)

    Next

End Sub

Public Function runCmd(strCmd As String) As String

    Dim fso As New FileSystemObject

    Dim tempFile As String

    Dim wsh As Object

    Dim waitOnReturn As Boolean

    Dim windowStyle As Integer

    Set wsh = CreateObject("WScript.Shell")

    tempFile = fso.GetSpecialFolder(TemporaryFolder) & "\" & Replace(fso.GetTempName(), ".tmp", ".txt")

    strCmd = "cmd /c " & strCmd & " > " & tempFile

    Debug.Print strCmd

    waitOnReturn = True

    windowStyle = 0

    wsh.Run strCmd, windowStyle, waitOnReturn

    On Error Resume Next

    runCmd = fso.OpenTextFile(tempFile, ForReading, False).ReadAll

End Function