Wrong Ascii characters with VBA Print #File command

[pieros]

I have a line in a text file in wich I want to replace some text.
I read a line of the file, check if it is the line to be modified. If
it is not than I go to the next line and so on till the end of the
file.
If it is the line to be modified than I replace the line part with the
correct text and want to write the corrected line back to the file.
So far looks good, but when I look in the corrected file in stead of
good characters I only see ascii squares.
(It is not the whole story but a short version of the actions)
Can someone help me with this please?

 

[Chris Lewis]

I have a line in a text file in wich I want to replace some text.
I read a line of the file, check if it is the line to be modified. If
it is not than I go to the next line and so on till the end of the
file.
If it is the line to be modified than I replace the line part with the
correct text and want to write the corrected line back to the file.
So far looks good, but when I look in the corrected file in stead of
good characters I only see ascii squares.
(It is not the whole story but a short version of the actions)
Can someone help me with this please?

Can you post the code you have already?

 

[pieros]

Can you post the code you have already?

Chris it is not a small code so please do not be shocked:
Here it is:

'Filename: Zoek tekst in files.xls - (modTestVBAprogr)
Option Explicit

Sub UpdateFiles()

'Declareren van variabelen
Dim RootFolder As String
Dim FoundFiles(1000) As String
Dim WorkFile As String
Dim IFileNum As Long
Dim OFileNum As Long
Dim WholeLine As String
Dim WholeLineExact As String
Dim i As Long, x As Integer
Dim TestDir As Variant
Dim RowNdx As Integer
Dim ColNdx As Integer
Dim myOutputFolder As String
Dim Regel As Integer

Dim FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object

ActiveCell.Range("A1").Select 'Zet cursor in excel in cel A1
ColNdx = 1 'Beginnen in 1e kolom
RowNdx = 1 'Beginnen in 1e rij

' RootFolder = "C:\Documents and Settings\meidamp\Desktop\Test\"
RootFolder = "D:\VBA\EM\VBA Excel\"

' Subfolders aanmaken ter voorbereiding van de KART-templates
wijziging.
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(RootFolder & "Approved\")

For Each oSubFolder In oFolder.SubFolders

'Foutafhandeling
On Error Resume Next

MkDir RootFolder & "Corrected\" & oSubFolder.Name
' Einde Subfolders aanmaken ter voorbereiding van de
KART-templates wijziging.

MkDir myOutputFolder
On Error GoTo 0

'----------------
'nieuwe methode:
'----------------

'Gewijzigde files naar deze locatie schrijven
myOutputFolder = RootFolder & "Corrected\" & oSubFolder.Name

i = 1
FoundFiles(i) = Dir(RootFolder & "Approved\" & oSubFolder.Name
& "\*.xml") 'Zoekactie in deze folder beginnen
Do While Not FoundFiles(i) = ""

IFileNum = FreeFile
Close #IFileNum
WorkFile = RootFolder & "Approved\" &
oSubFolder.Name & "\" & FoundFiles(i)
Open WorkFile For Input As #IFileNum 'Voorbereiden
voor het ophalen van tekstregels

OFileNum = FreeFile
Close #OFileNum
Open myOutputFolder & "\" & FoundFiles(i) For
Output As #OFileNum ' Voorbereiden voor het wegschrijven

TestDir = WorkFile
' TestDir = Mid(TestDir, 64, 40)

Regel = 1 'Regelteller op 1 zetten

While Not EOF(IFileNum) 'Zolang het einde van het
tekstfile niet is bereikt; ga door
Line Input #IFileNum, WholeLine 'Lees een regel
in
WholeLineExact = WholeLine
If Len(Trim(WholeLine)) > 0 Then 'Staat er
tekst in deze regel ga dan door
If Mid(WholeLine, 26, 11) = "1LS-Arial-U"
Then 'Zet tekst in excel-file
Cells(RowNdx, ColNdx).Value = "De tekst
'1LS-Arial-U' staat in regel " & Regel & " van " & TestDir & "."
RowNdx = RowNdx + 1 'Regel in excel een
positie naar beneden
WholeLine = Replace(Mid(WholeLine, 26,
11), "1LS-Arial-U", "1LS-OCR-B-10 BT")
WholeLineExact = "<FontName
type=""CString"">" & WholeLine & "/FontName>"
' Print #OFileNum, WholeLineExact
'Schrijf deze gewijzigde tekst naar het output file.
End If
If Mid(WholeLine, 26, 10) = "1LS-Arial<"
Then 'Zet tekst in excel-file
Cells(RowNdx, ColNdx).Value = "De tekst
'1LS-Arial ' staat in regel " & Regel & " van " & TestDir & "."
RowNdx = RowNdx + 1 'Regel in excel een
positie naar beneden
WholeLine = Replace(Mid(WholeLine, 26,
10), "1LS-Arial<", "1LS-OCR-B-10 BT<")
WholeLineExact = "<FontName
type=""CString"">" & WholeLine & "/FontName>"
' Print #OFileNum, WholeLineExact
'Schrijf deze gewijzigde tekst naar het output file.
End If
If Mid(WholeLine, 26, 15) = "1LS-OCR-B-10
BT" Then 'Zet tekst in excel-file
Cells(RowNdx, ColNdx).Value = "De tekst
'1LS-OCR-B-10 BT' staat al in regel " & Regel & " van " & TestDir & "."
'File hoeft niet te worden aangepast.
RowNdx = RowNdx + 1 'Regel in excel een
positie naar beneden
' Print #OFileNum, WholeLineExact
'Schrijf deze gewijzigde tekst naar het output file.
End If
' Else
Print #OFileNum, WholeLineExact
'Schrijf deze gewijzigde tekst naar het output file.
Print #OFileNum, WholeLineExact 'Schrijf deze gewijzigde
tekst naar het output file.
End If
Regel = Regel + 1 ' Regelteller verhogen
Wend

RowNdx = RowNdx + 1 'Regel in excel een positie
naar beneden
Close #IFileNum
Close #OFileNum

i = i + 1
FoundFiles(i) = Dir 'Volgende file opzoeken. Maakt
gebruik van bovenstaande dir commando ("FoundFiles(i) = Dir(RootFolder
& "\App .......")

Loop

It is commented in Dutch so if you have more questions about it let me
know.

Regards,
Pieros.