'Deletes all data in files in and under the supplied
'folder by setting file sizes to zero.

Option Explicit

Main

Sub Main()
Dim fs, strFolder, fol
    Set fs = CreateObject("Scripting.FileSystemObject")
    If WScript.Arguments.Count <> 1 Then
        Help
        Exit Sub
    End If
    strFolder = WScript.Arguments(0)
    If Not fs.FolderExists(strFolder) Then
        Help
        Exit Sub
    End If
    If MsgBox("Do you want to DELETE all data in all files in and under the """ & strFolder & """ folder? If you answer ""Yes"", then all files will have their sizes set to ZERO.", vbYesNo + vbCritical, "WARNING") <> vbYes Then
        Exit Sub
    End If
    Set fol = fs.GetFolder(strFolder)
    RecurseFiles(fol)
End Sub

Function RecurseFiles(objFolder)'As Long
Dim fils, fil, fols, fol
    'On Error Resume Next
    'Get each file in turn
    Set fils = objFolder.Files
    If Err.Number <> 0 Then Exit Function
    For Each fil In fils
        'Insert code here to process individual file "fil"
        ZeroFile fil
    Next
    'Check for any sub folders and recursively process them
    Set fols = objFolder.SubFolders
    For each fol in fols
        If Lcase(fol.Name) <> "recycled" Then
            RecurseFiles(fol)
        End If
    Next
End Function

Sub ZeroFile(oFile)
Dim fs, ts
Const ForWriting = 2
    On Error Resume Next 'In case of readonly files
    Set ts = oFile.OpenAsTextStream(ForWriting)
    ts.Close
End Sub

Sub Help()
Dim strAlert
    strAlert = "Drop a folder on this script -OR- pass a folder"
    strAlert = strAlert & vbCrLf & "as an argument. All files in and under that folder"
    strAlert = strAlert & vbCrLf & "will be set to zero bytes, effectively deleting"
    strAlert = strAlert & vbCrLf & "all the data in the files. The file names will"
    strAlert = strAlert & vbCrLf & "be the only thing that will survive."
    WScript.Echo strAlert
End Sub