OPTION EXPLICIT
Dim FSO, LogFile, LogFilePath
 
Set FSO = CreateObject("Scripting.FileSystemObject")
LogFilePath = FSO.GetParentFolderName(WScript.ScriptFullName) & _
  "\DeleteCustomDocumentProperties.log"
If Not FSO.FileExists(LogFilePath) Then
  Set LogFile = FSO.CreateTextFile(LogFilePath, True)
  LogFile.Close
End If
 
Set LogFile = FSO.OpenTextFile(LogFilePath, 8, True)
Call ListDir("C:\Tabellen")
LogFile.Close
CreateObject("WScript.Shell").Run "notepad " & LogFilePath, 1, False
 
Sub ListDir(ByVal DirPath)
  Const EXTENSION = "xls"
  Dim Dir, SubFolder, File
 
  Set Dir = FSO.GetFolder(DirPath)
 
  For Each File In Dir.Files
    If LCase(FSO.GetExtensionName(File)) = EXTENSION Then
      Call DelCustomDocProperties(File.Path)
    End If
  Next
 
  For Each SubFolder In Dir.SubFolders
    Call ListDir(SubFolder)
  Next
End Sub
 
Sub DelCustomDocProperties(ByVal xlsPath)
  Dim Excel, Workbook, Property
 
  LogFile.WriteLine xlsPath
  Set Excel = CreateObject("Excel.Application")
  Set Workbook = Excel.Workbooks.Open(xlsPath)
 
  For Each Property In Workbook.CustomDocumentProperties
    LogFile.WriteLine vbTab & Property.Name & " – " & Property.Value
    Property.Delete
  Next
  Workbook.Save
  Excel.Quit
  Set Excel = Nothing
End Sub