I just saw the possibilties of scripting. Within MS-word
I have a macro to replace text in a word file. I thought
I could copy it into a vsb-file and run, but that was to
easy.
What I want todo is translate a html-file with genealogy
information from English to Dutch.

The code in the macro consist of :
Sub Translate()
'
' Translate Macro
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting

'First --> Eerste
    With Selection.Find
        .Text = " First"
        .Replacement.Text = " Eerste"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'was born on --> geboren op
    With Selection.Find
        .Text = "was born on"
        .Replacement.Text = " is geboren op"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    'was born --> geboren
    With Selection.Find
        .Text = "was born "
        .Replacement.Text = " is geboren "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'.
'.
'etc.  

End Sub

I knew that I asked a lot, but I hope someone can help me.

Thanks,
Fred Baltus

Try this:

    Option Explicit
   '==========================================================================='
   '  "Qeng2dut.vbs"    Date Created: 29-Dec-2002    Date Updated: 29-Dec-2002
   '
   '  This VBS (Visual Basic Script) program does the following:
   '  1)  Reads a file, translates it, and writes a file.
   '  2)  The output file has the same name as the input file plus ".txt".
   '
   '  To test, either double-click on the filename in Windows Explorer or
   '  from the Command prompt, type "cscript Qeng2dut.vbs".
   '
   '  Changes:
   '  -------------------------------------------------------------------------
   '  29-Dec-2002.0  Created.
   '
   '==========================================================================='
    Const cVBS = "Qeng2dut.vbs"
   '*
   '*  Start Message
   '*
    MsgBox "'" & cVBS & "' started."
   '*
   '*  Declare Globals
   '*
    Dim strOT1
        strOT1 = InputBox("Enter a valid filename",cVBS)
    Dim strOT2
        strOT2 = strOT1 & ".txt"
   '*
   '*  Process
   '*
    If strOT1 <> "" Then
        MsgBox "Filename = '" & strOT1 & "'"
        ReadWrite()
    Else
        MsgBox "Filename missing!"
    End If
   '*
   '*  Finish Message
   '*
    MsgBox "'" & cVBS & "' finished."

Sub ReadWrite()
   '*
   '*  Declare Variables
   '*
    Dim arrE2D(2)
        arrE2D(0) = "First|Eerste"
        arrE2D(1) = "was born on|geboren op"
        arrE2D(2) = "was born|geboren"
    Dim intE2D
    Dim strE2D
    Dim intOFF
    Dim strOTF
   '*
   '*  Open Files
   '*
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objOT1
    Set objOT1 = objFSO.OpenTextFile(strOT1,1)
    Dim objOT2
    Set objOT2 = objFSO.OpenTextFile(strOT2,2,true)
   '*
   '*  Read and Write Files
   '*
    Do While Not objOT1.AtEndOfStream
        strOTF = objOT1.ReadLine()
        For intE2D = 0 To UBound(arrE2D)
            strE2D = Split(arrE2D(intE2D),"|")
            intOFF = InStr(strOTF,strE2D(0))
            If intOFF > 0 Then
                strOTF = Left(strOTF,intOFF-1) & strE2D(1) & Mid(strOTF,intOFF+Len(strE2D(0)))
            End If
        Next
        objOT2.WriteLine(strOTF)
    Loop
   '*
   '*  Close Files
   '*
        objOT1.Close()
    Set objOT1 = Nothing
        objOT2.Close()
    Set objOT2 = Nothing
    Set objFSO = Nothing
End Sub

Thanks it works. I must know look that it automaticly
search for files in a given folder and process then the
founded files.

The result of your code you can see, tomorrow, on
http:\\home.hccnet.nl\roots.htm (stamboom Baltus)

According the way you setup the code, you must be a pro!

For calling me a pro, here's a variation that uses "BrowseForFolder" to support file selection.  

Also, a counter has added to count the number of "changes" (translations) made.

I'll check out ' http://www.hccnet.nl/roots.htm ' tomorrow.

    Option Explicit
   '==========================================================================='
   '  "Qeng3dut.vbs"    Date Created: 29-Dec-2002    Date Updated: 30-Dec-2002
   '
   '  This VBS (Visual Basic Script) program does the following:
   '  1)  Reads a file, translates it, and writes a file.
   '  2)  The output file has the same name as the input file plus ".txt".
   '
   '  To test, either double-click on the filename in Windows Explorer or
   '  from the Command prompt, type "cscript Qeng3dut.vbs".
   '
   '  Changes:
   '  -------------------------------------------------------------------------
   '  30-Dec-2002.0  Created from "Qeng2dut.vbs".
   '
   '==========================================================================='
    Const cVBS = "Qeng3dut.vbs"
   '*
   '*  Start Message
   '*
    MsgBox "'" & cVBS & "' started."
   '*
   '*  Declare Globals
   '*
    Dim strOT1
        strOT1 = BrowseForFolder("File","Browse for a file to translate","C:\")
    If (strOT1 = "") Then
        strOT1 = InputBox("Enter a file to translate",cVBS)
    End If
    Dim strOT2
        strOT2 = strOT1 & ".txt"
    Dim intOTF
        intOTF = 0
   '*
   '*  Process
   '*
    If strOT1 <> "" Then
        MsgBox "File = '" & strOT1 & "'"
        ReadWrite()
        MsgBox FormatNumber(intOTF,0) & " changes"
    Else
        MsgBox "Filename missing!"
    End If
   '*
   '*  Finish Message
   '*
    MsgBox "'" & cVBS & "' finished."

Sub ReadWrite()
   '*
   '*  Declare Variables
   '*
    Dim arrE2D(2)
        arrE2D(0) = "First|Eerste"
        arrE2D(1) = "was born on|geboren op"
        arrE2D(2) = "was born|geboren"
    Dim intE2D
    Dim strE2D
    Dim intOFF
    Dim strOTF
   '*
   '*  Open Files
   '*
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Not objFSO.FileExists(strOT1) Then
        MsgBox "File doesn't exist!"
        Exit Sub
    End If
   '*
    Dim objOT1
    Set objOT1 = objFSO.OpenTextFile(strOT1,1)
    Dim objOT2
    Set objOT2 = objFSO.OpenTextFile(strOT2,2,true)
   '*
   '*  Read and Write Files
   '*
    Do While Not objOT1.AtEndOfStream
        strOTF = objOT1.ReadLine()
        For intE2D = 0 To UBound(arrE2D)
            strE2D = Split(arrE2D(intE2D),"|")
            intOFF = InStr(strOTF,strE2D(0))
            If intOFF > 0 Then
                intOTF = intOTF + 1
                strOTF = Left(strOTF,intOFF-1) & strE2D(1) & Mid(strOTF,intOFF+Len(strE2D(0)))
            End If
        Next
        objOT2.WriteLine(strOTF)
    Loop
   '*
   '*  Close Files
   '*
        objOT1.Close()
    Set objOT1 = Nothing
        objOT2.Close()
    Set objOT2 = Nothing
    Set objFSO = Nothing
End Sub

Function BrowseForFolder(sBFF,sPMT,sDIR)
    BrowseForFolder = ""
    If sBFF <> "Folder" And sBFF <> "File" Then Exit Function
   '*
    Dim objSHL
    Set objSHL = CreateObject("Shell.Application")
    Dim objB4F
   '*
    On Error Resume Next
    If sBFF = "Folder" Then
        Set objB4F = objSHL.BrowseForFolder(&H0,sPMT,&H0031,sDIR)
    Else
        Set objB4F = objSHL.BrowseForFolder(&H0,sPMT,&H4031,sDIR)
    End If
    BrowseForFolder = objB4F.ParentFolder.ParseName(objB4F.Title).Path
    If Err.Number <> 0 Then BrowseForFolder = ""
   '*
    Set objB4F = Nothing
    Set objSHL = Nothing
End Function

Thanks i will try it, save me a lot of typing...
The address, i typed in, is not correct, try
http://home.hccnet.nl/f.baltus/roots.htm

Thanks again,
fred

Hi,

I got errors when executing the script....when I select a
file the item strOT1 is empty...but i changed it. I only
want to select a folder and then translate all the htm-
files in that folder and write it back to a translation-
folder in the same folder...I have copied something from
examples, but i have to look to make it more dynamic ( i
don't understand all the things I have copied.

Here is the modified listing :
=========================

   Option Explicit
   '======================================================
====================='
   '  "VertaalRoots.vbs"    Date Created: 29-Dec-2002    
Date Updated: 29-Dec-2002
   '
   '  This VBS (Visual Basic Script) program does the
following:
   '  1)  Reads a file, translates it, and writes a file.
   '  2)  The output file has the same name as the input
file plus ".txt".
   '
   '  To test, either double-click on the filename in
Windows Explorer or
   '  from the Command prompt, type "cscript
Qeng2dut.vbs".
   '
   '  Changes:
   '  ----------------------------------------------------
---------------------
   '  29-Dec-2002.0  Created.
   '
   '======================================================
====================='

    Const cVBS = "VertaalRoots2.vbs"
   '*
   '*  Start Message
   '*
    MsgBox "'" & cVBS & "' started."

   '*
   '*  Declare Globals
   '*
    Dim strComputer
        strComputer = "."
    Dim strOT1
    Dim strOT1F

    Dim strOT2
    Dim intOTF
        intOTF = 0
    Dim objWMIService
    Dim FileList
    Dim objFile
   '*

    Set objWMIService = GetObject("winmgmts:" _
          & "{impersonationLevel=impersonate}!\\" &
strComputer & "\root\cimv2")
    Set FileList = objWMIService.ExecQuery _
        ("ASSOCIATORS OF _
{Win32_Directory.Name='c:\Scripts'} Where " _
                     & "ResultClass = CIM_DataFile")

   '*  Process
   '*
       For Each objFile In FileList
          If objFile.Extension = "htm" Then
            strOT1F = objFile.FileName & "." &
objFile.Extension
            strOT2 = "c:\scripts\translate\" & strOT1F
            strOT1 = objFile.Drive & objFile.Path _
   & objFile.FileName & "." & objFile.Extension
            If strOT1 <> "" Then
    '         MsgBox "File = '" & strOT1 & "'"
              ReadWrite()
    '         MsgBox FormatNumber(intOTF,0) & " changes"
            Else
              MsgBox "Filename missing!"
            End If
          End if
       Next
   '*
   '*  Finish Message
   '*
    MsgBox "'" & cVBS & "' finished."

Sub ReadWrite()
   '*
   '*  Declare Variables
   '*
    Dim arrE2D(52)
        arrE2D(0) = "First|Eerste"
        arrE2D(1) = " was born on| is geboren op"
        arrE2D(2) = " was born in| is geboren in"
        arrE2D(3) = " was born about| is geboren rond"
        arrE2D(4) = " about| rond"
        arrE2D(5) = " was christened| was gedoopt"
        arrE2D(6) = " died in| is overleden in"
        arrE2D(7) = " died on| is overleden op"
        arrE2D(8) = " died| is overleden"

        arrE2D(51) = " and | en "
        arrE2D(52) = " on | op "

   Dim intE2D
    Dim strE2D
    Dim intOFF
    Dim strOTF
   '*
   '*  Open Files
   '*
    Dim objFSO
    Set objFSO = CreateObject
("Scripting.FileSystemObject")
    If Not objFSO.FileExists(strOT1) Then
        MsgBox "File doesn't exist!"
        Exit Sub
    End If

    Dim objOT1
    Set objOT1 = objFSO.OpenTextFile(strOT1,1)
    Dim objOT2
    Set objOT2 = objFSO.OpenTextFile(strOT2,2,true)
   '*
   '*  Read and Write Files
   '*
    Do While Not objOT1.AtEndOfStream
        strOTF = objOT1.ReadLine()
        For intE2D = 0 To UBound(arrE2D)
            strE2D = Split(arrE2D(intE2D),"|")
            intOFF = InStr(strOTF,strE2D(0))
            If intOFF > 0 Then
              intOTF = intOTF + 1
              strOTF = Left(strOTF,intOFF-1) & strE2D(1)
& Mid(strOTF,intOFF+Len(strE2D(0)))
            End If
        Next
        objOT2.WriteLine(strOTF)
    Loop
   '*
   '*  Close Files
   '*
        objOT1.Close()
    Set objOT1 = Nothing
        objOT2.Close()
    Set objOT2 = Nothing
    Set objFSO = Nothing
End Sub

Here's a revision that retrieves the files in a folder without using WMI.

Test it then adjust " arrE2D() ".

    Option Explicit
   '==========================================================================='
   '  "VertaalRoots2.vbs"  Date Created: 29-Dec-2002  Date Updated: 30-Dec-2002
   '
   '  This VBS (Visual Basic Script) program does the following:
   '  1)  Allows selection of a folder via BrowseForFolder
   '  2)  Reads each ".htm" file, translates it, and writes it to a new file.
   '
   '  To test, either double-click on the filename in Windows Explorer or
   '  from the Command prompt, type "cscript VertaalRoots2.vbs".
   '
   '  Changes:
   '  -------------------------------------------------------------------------
   '  30-Dec-2002.0  Changed.
   '  29-Dec-2002.0  Created.
   '
   '==========================================================================='
    Const cVBS = "VertaalRoots2.vbs"
    Const cOUT = "c:\scripts\translate\"
   '*
   '*  Start Message
   '*
    MsgBox "'" & cVBS & "' started."
   '*
   '*  Declare Globals
   '*
    Dim intGFI
        intGFI = 0
    Dim strOT1
    Dim strOT2
    Dim intOTF
        intOTF = 0
   '*
   '*  Processing
   '*
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Call Folder()
    Set objFSO = Nothing
   '*
   '*  Finish Message
   '*
    MsgBox "'" & cVBS & "' finished."

Sub Folder()
   '*
   '*  Output Folder Exists?
   '*
    If Not objFSO.FolderExists(cOUT) Then
        MsgBox "Output folder doesn't exist!"
        Exit Sub
    End If
   '*
   '*  Input Folder Selection
   '*
    Dim strFOL
        strFOL = BrowseForFolder("Folder","Browse for a folder","")
   '*
   '*  Input Folder Exists?
   '*
    If Not objFSO.FolderExists(strFOL) Then
        MsgBox "Input folder doesn't exist!"
        Exit Sub
    End If
   '*
   '*  Input Files Exist?
   '*
    Dim objGFO
    Set objGFO = objFSO.GetFolder(strFOL)
    If objGFO.Files.Count = 0 Then
        MsgBox "Input folder has no files!"
        Exit Sub
    End If
   '*
   '*  Input Files Process
   '*
    Dim objGFI
    Set objGFI = objGFO.Files
    Dim strGFI
    For Each strGFI in objGFI
        If LCase(Right(strGFI,4)) = ".htm" Then
            intGFI = intGFI + 1
            strOT1 = strGFI.Name
            strOT2 = cOUT & Mid(strOT1,InStrRev(strOT1,"\")+1)
            Call ReadWrite()
        End If
    Next
    Set objGFI = Nothing
    Set objGFO = Nothing
   '*
    If intGFI = 0 Then
        MsgBox "Input folder has no '.htm' files!"
        Exit Sub
    End If
   '*
   '*  Displays Counts
   '*
    MsgBox FormatNumber(intGFI,0) & " files had" & vbCrLf & FormatNumber(intOTF,0) & " changes."
End Sub

Sub ReadWrite()
   '*
   '*  Declare Variables
   '*
'    Dim arrE2D(52)
    Dim arrE2D(8)
        arrE2D(0) = "First|Eerste"
        arrE2D(1) = " was born on| is geboren op"
        arrE2D(2) = " was born in| is geboren in"
        arrE2D(3) = " was born about| is geboren rond"
        arrE2D(4) = " about| rond"
        arrE2D(5) = " was christened| was gedoopt"
        arrE2D(6) = " died in| is overleden in"
        arrE2D(7) = " died on| is overleden op"
        arrE2D(8) = " died| is overleden"
'?
'        arrE2D(51) = " and | en "
'        arrE2D(52) = " on | op "
    Dim intE2D
    Dim strE2D
    Dim intOFF
    Dim strOTF
   '*
   '*  Open Files
   '*
    Dim objOT1
    Set objOT1 = objFSO.OpenTextFile(strOT1,1)
    Dim objOT2
    Set objOT2 = objFSO.OpenTextFile(strOT2,2,true)
   '*
   '*  Read and Write Files
   '*
    Do While Not objOT1.AtEndOfStream
        strOTF = objOT1.ReadLine()
        For intE2D = 0 To UBound(arrE2D)
            strE2D = Split(arrE2D(intE2D),"|")
            intOFF = InStr(strOTF,strE2D(0))
            If intOFF > 0 Then
                intOTF = intOTF + 1
                strOTF = Left(strOTF,intOFF-1) & strE2D(1) & Mid(strOTF,intOFF+Len(strE2D(0)))
            End If
        Next
        objOT2.WriteLine(strOTF)
    Loop
   '*
   '*  Close Files
   '*
        objOT1.Close()
    Set objOT1 = Nothing
        objOT2.Close()
    Set objOT2 = Nothing
End Sub

Function BrowseForFolder(sBFF,sPMT,sDIR)
    BrowseForFolder = ""
    If sBFF <> "Folder" And sBFF <> "File" Then Exit Function
   '*
    Dim objSHL
    Set objSHL = CreateObject("Shell.Application")
    Dim objB4F
   '*
    On Error Resume Next
    If sBFF = "Folder" Then
        Set objB4F = objSHL.BrowseForFolder(&H0,sPMT,&H0031,sDIR)
    Else
        Set objB4F = objSHL.BrowseForFolder(&H0,sPMT,&H4031,sDIR)
    End If
    BrowseForFolder = objB4F.ParentFolder.ParseName(objB4F.Title).Path
    If Err.Number <> 0 Then BrowseForFolder = ""
   '*
    Set objB4F = Nothing
    Set objSHL = Nothing
End Function

Since you know the input folder,

you could add the following:

    Const cINP = "c:\scripts\"

and make the following change:

        strFOL = BrowseForFolder("Folder","Browse for a folder",cINP)

or, if it never varies, this change:

        strFOL = cINP

I used "Const"ants for your folder names so they can more easily be changed.

Thanks...there was just one small bug.
============================
    For Each strGFI in objGFI
        If LCase(Right(strGFI,4)) = ".htm" Then
            intGFI = intGFI + 1
  ------->  strOT1 = strGFI.Name '<-------This was wrong
            strOT2 = cOUT & Mid(strOT1,InStrRev
(strOT1,"\")+1)
            Call ReadWrite()
        End If

Because you save only the name of the file in the string
strOT1, the file could not be found in the directory when
you open it in the readwrite subroutine..

BTW : What is a goog book about VBScripting?

Thanks,
Fred
(Happy New Year)

Thanks!

A last question... is it also possible to show that the
procedure is running without showing a msgbox with a
button?

Thanks McKirahan!

There was also a little bug. For example if "He " occurs
more then 1 time only the first "He " was translated.
I do the test now within a do While loop.
I put also the items to translate in a seperate file.

A last question... is it also possible to show that the
procedure is running without showing a msgbox with a
button?

http://msdn.microsoft.com/downloads/default.asp?url=/downloads/topic....

Click on the "Microsoft Windows Script 5.6 Documentation" link, download it, execute it to extract the files, then drag (using Windows Explorer) "script56.chm" to the Desktop and "Create Shortcut(s) Here" -- then it's readily available.

Also, I like Wrox books.  Several of them have a section on VBScript: For example, Windows Script Host -- Programmer's Reference and Professional Active Server Pages 3.0.

Here is a revised version of the code that includes fixes to the errors you pointed out:

    Option Explicit
   '==========================================================================='
   '  "VertaalRoots2.vbs"  Date Created: 29-Dec-2002  Date Updated: 03-Jan-2003
   '
   '  This VBS (Visual Basic Script) program does the following:
   '  1)  Allows selection of a folder via BrowseForFolder;
   '  2)  Reads each ".htm" file, translates it, and writes it to a new file.
   '
   '  To test, either double-click on the filename in Windows Explorer or
   '  from the Command prompt, type "cscript VertaalRoots2.vbs".
   '
   '  Changes:
   '  -------------------------------------------------------------------------
   '  03-Jan-2003.0  Changed.
   '  30-Dec-2002.0  Changed.
   '  29-Dec-2002.0  Created.
   '
   '==========================================================================='
    Const cVBS = "VertaalRoots2.vbs"
    Const cINP = "c:\scripts\"
    Const cOUT = "c:\scripts\translate\"
   '*
   '*  Start Message
   '*
    MsgBox "'" & cVBS & "' started."
   '*
   '*  Declare Globals
   '*
    Dim intGFI
        intGFI = 0
    Dim strOT1
    Dim strOT2
    Dim intOTF
        intOTF = 0
   '*
   '*  Processing
   '*
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Call Folder()
    Set objFSO = Nothing
   '*
   '*  Finish Message
   '*
    MsgBox "'" & cVBS & "' finished."

Sub Folder()
   '*
   '*  Output Folder Exists?
   '*
    If Not objFSO.FolderExists(cOUT) Then
        MsgBox "Output folder doesn't exist!"
        Exit Sub
    End If
   '*
   '*  Input Folder Selection
   '*
    Dim strFOL
    If MsgBox("Use folder '" & cINP & "'?",vbQuestion+vbYesNo,cVBS) = vbYes Then
        strFOL = cINP
    Else
        strFOL = BrowseForFolder("Folder","Browse for a folder","")
    End If
   '*
   '*  Input Folder Exists?
   '*
    If Not objFSO.FolderExists(strFOL) Then
        MsgBox "Input folder doesn't exist!"
        Exit Sub
    End If
   '*
   '*  Input Files Exist?
   '*
    Dim objGFO
    Set objGFO = objFSO.GetFolder(strFOL)
    If objGFO.Files.Count = 0 Then
        MsgBox "Input folder has no files!"
        Exit Sub
    End If
   '*
   '*  Input Files Process
   '*
    Dim objWSH
    Set objWSH = CreateObject("WScript.Shell")
    Dim objGFI
    Set objGFI = objGFO.Files
    Dim strGFI
    For Each strGFI in objGFI
        If LCase(Right(strGFI,4)) = ".htm" Then
            intGFI = intGFI + 1
            strOT1 = strFOL & strGFI.Name
            objWSH.Popup strOT1,1,cVBS,vbInformation
            strOT2 = cOUT & Mid(strOT1,InStrRev(strOT1,"\")+1)
            Call ReadWrite()
        End If
    Next
    Set objGFI = Nothing
    Set objGFO = Nothing
    Set objWSH = Nothing
   '*
   '*  Displays Counts
   '*
    MsgBox FormatNumber(intGFI,0) & " files had" & vbCrLf & FormatNumber(intOTF,0) & " changes."
End Sub

Sub ReadWrite()
   '*
   '*  Declare Variables
   '*
'    Dim arrE2D(52)
    Dim arrE2D(8)
        arrE2D(0) = "First|Eerste"
        arrE2D(1) = " was born on| is geboren op"
        arrE2D(2) = " was born in| is geboren in"
        arrE2D(3) = " was born about| is geboren rond"
        arrE2D(4) = " about| rond"
        arrE2D(5) = " was christened| was gedoopt"
        arrE2D(6) = " died in| is overleden in"
        arrE2D(7) = " died on| is overleden op"
        arrE2D(8) = " died| is overleden"
'?
'        arrE2D(51) = " and | en "
'        arrE2D(52) = " on | op "
    Dim intE2D
    Dim strE2D
    Dim intOFF
    Dim strOTF
   '*
   '*  Open Files
   '*
    Dim objOT1
    Set objOT1 = objFSO.OpenTextFile(strOT1,1)
    Dim objOT2
    Set objOT2 = objFSO.OpenTextFile(strOT2,2,true)
   '*
   '*  Read and Write Files
   '*
    Do While Not objOT1.AtEndOfStream
        strOTF = objOT1.ReadLine()
        For intE2D = 0 To UBound(arrE2D)
            strE2D = Split(arrE2D(intE2D),"|")
            intOFF = InStr(strOTF,strE2D(0))
            Do Until intOFF = 0
                intOTF = intOTF + 1
                strOTF = Left(strOTF,intOFF-1) & strE2D(1) & Mid(strOTF,intOFF+Len(strE2D(0)))
                intOFF = InStr(strOTF,strE2D(0))
            Loop
        Next
        objOT2.WriteLine(strOTF)
    Loop
   '*
   '*  Close Files
   '*
        objOT1.Close()
    Set objOT1 = Nothing
        objOT2.Close()
    Set objOT2 = Nothing
End Sub

Function BrowseForFolder(sBFF,sPMT,sDIR)
    BrowseForFolder = ""
    If sBFF <> "Folder" And sBFF <> "File" Then Exit Function
   '*
    Dim objSHL
    Set objSHL = CreateObject("Shell.Application")
    Dim objB4F
   '*
    On Error Resume Next
    If sBFF = "Folder" Then
        Set objB4F = objSHL.BrowseForFolder(&H0,sPMT,&H0031,sDIR)
    Else
        Set objB4F = objSHL.BrowseForFolder(&H0,sPMT,&H4031,sDIR)
    End If
    BrowseForFolder = objB4F.ParentFolder.ParseName(objB4F.Title).Path
    If Err.Number <> 0 Then BrowseForFolder = ""
   '*
    Set objB4F = Nothing
    Set objSHL = Nothing
End Function

   '*
   '*  Input Files Process
   '*
    Dim objWSH
    Set objWSH = CreateObject("WScript.Shell")
    Dim objGFI
    Set objGFI = objGFO.Files
    Dim strGFI
    For Each strGFI in objGFI
        If LCase(Right(strGFI,4)) = ".htm" Then
            intGFI = intGFI + 1
            strOT1 = strFOL & strGFI.Name
            objWSH.Popup strOT1,1,cVBS,vbInformation
            strOT2 = cOUT & Mid(strOT1,InStrRev(strOT1,"\")+1)
            Call ReadWrite()
        End If
    Next
    Set objGFI = Nothing
    Set objGFO = Nothing
    Set objWSH = Nothing

If the command :
Set objWSH = CreateObject("WScript.Shell")

is executed i got an error message  that
"class factory can not suply requested class"
(free translation from dutch-message....
if I only execute the statements in a seperate vbs-
script, all is going fine.

Btw. You have a nice site!

WScript.CreateObject("WScript.Shell")