VBS Script um Emailadressen aus einer TXT, CSV oder XLS-Datei zu lesen

$allMails = 'd:\all_mails.txt'  
gci "D:\Ordner\*" -Include "*.csv","*.txt" -recurse | %{([regex]'(?i)[a-z0-9._%+-]+@[a-z0-9.-]+\.[a-z]{2,6}').matches((gc $_.Fullname)) | select -Expand Value | out-file $allMails -Append}  

Option Explicit
Const strOutFile = "emailaddresses.txt"  

Const ForReading = 1, ForWriting = 2
Dim objFSO, objFolder, objInFile, objOutFile, objStream, objRegex, colMatches, _
    objExcelApp, objWorkbook, objWorksheet, objCell, _
    strFolderpath, strFilepath, strExtension, strContent, strMatch

Set objFSO = CreateObject("Scripting.FileSystemObject")  

Set objRegex = New RegExp
objRegex.Pattern = "\b[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\b"  
objRegex.IgnoreCase = True
objRegex.Global = True

Set objFolder = objFSO.GetFolder(objFSO.GetParentFolderName(WScript.ScriptFullName))

Set objOutFile = objFSO.OpenTextFile(strOutfile, ForWriting, True)

Set objExcelApp = CreateObject("Excel.Application")  
objExcelApp.Visible = False


For Each objInFile In objFolder.Files
  If Not StrComp(objInFile.Name, strOutfile, vbTextCompare) = 0 Then
    strFilepath = objInFile.Path
    strExtension = objFSO.GetExtensionName(strFilepath)

    If StrComp(strExtension, "txt", vbTextCompare) = 0 Or StrComp(strExtension, "csv", vbTextCompare) = 0 Then  

      Set objStream = objInFile.OpenAsTextStream(ForReading)
      strContent = objStream.ReadAll
      Set colMatches = objRegex.Execute(strContent)
      If colMatches.Count <> 0 Then
        For Each strMatch In colMatches
          objOutFile.WriteLine strMatch
        Next
      End If
      objStream.Close

    ElseIf StrComp(strExtension, "xls", vbTextCompare) = 0 Then  

      Set objWorkbook = objExcelApp.Workbooks.Open(strFilepath, 0, True)
      For Each objWorksheet In objWorkbook.Worksheets
        For Each objCell In objWorksheet.UsedRange.Cells
          strContent = CStr(objCell)
          If strContent <> "" Then  
            Set colMatches = objRegex.Execute(strContent)
            If colMatches.Count <> 0 Then
              For Each strMatch In colMatches
                objOutFile.WriteLine strMatch
              Next
            End If
          End If
        Next
      Next
      objWorkbook.Close False

    End If

  End If
Next

objExcelApp.Quit
objOutFile.Close