Thema: Buchstaben aus Textdatei entfernen und neu speichern

StandardModule: Modul1

Sub SearchAndChange()
   Dim FSO As Object
   Dim oFile As Object
   Dim oOFile As Object
   Dim oStrm As Object
   Dim oOStrm As Object
   Dim iRow As Integer
   Dim sTxt As String, sSource As String, sTarget As String
   Set FSO = New Scripting.FileSystemObject
   sSource = Range("B1").Value
   sTarget = Range("B2").Value
   Set oFile = FSO.GetFile(sSource)
   Set oStrm = oFile.OpenAsTextStream(ForReading)
   sTxt = oStrm.ReadAll
   oStrm.Close
   sTxt = CharFilter(sTxt)
   FSO.CreateTextFile sTarget, True
   Set oOFile = FSO.GetFile(sTarget)
   Set oOStrm = oOFile.OpenAsTextStream(ForWriting)
   oOStrm.Write sTxt
   oOStrm.Close
   MsgBox sTxt
   iRow = iRow + 1
   Set FSO = Nothing
End Sub

Function CharFilter(sTxt As String) As String
   Dim aRegExp As Object
   Set aRegExp = CreateObject("vbscript.regexp")
   aRegExp.Pattern = "[a-zA-Zäöü]"
   aRegExp.Global = True
   CharFilter = aRegExp.Replace(sTxt, "")
End Function

Beiträge aus dem Excel-Forum zu den Themen Extern und VBScript