find & replace

G

Guest

I found the following code and am having diffculty with the replace portion.
I am hoping someone can take a look and offer any suggestions. It doesnt seem
to find a match from txtsearch tetbox. When I do a debug for strline I
clearly see text. I want to do a replace ALL.

Private Function funEditFile(intInput As Integer, intOutput As Integer) As
Boolean
Dim strLine As String
Dim intPos As Integer
Dim booMatch As Boolean
Dim strNewLine As String
Dim booChanged As Boolean

booChanged = False
Do While Not EOF(intInput)
' read one line of text:
Line Input #intInput, strLine
If Not EOF(intInput) Then

' replace all occurrences of the txtSearch text in strLine:
booMatch = True
intPos = 1
****PROBLEM BEGINS HERE*****
Do While booMatch
intPos = InStr(intPos, strLine, txtSearch)

If ((intPos = 1) And (chkColumn1)) Or _
((intPos > 0) And (Not chkColumn1)) Then
' match found, change it
strLine = Left(strLine, intPos - 1) + txtNew +
Mid(strLine, intPos + Len(txtSearch))
intPos = intPos + Len(txtNew)

booMatch = True
booChanged = True
Else
booMatch = False
End If
Loop

Print #intOutput, strLine
End If
Loop

funEditFile = booChanged
End Function

Private Sub cmdRenameNow_Click()
On Error GoTo Err_cmdRenameNow_Click

Dim stAppName As String
Dim strFile As String
Dim strNewFile As String
Dim intPos As Integer
Const conQuote = 34
Dim intCount As Integer
Dim intTotal As Integer
Dim booChanged As Boolean
Const conInput = 1
Const conOutput = 2

txtresult = "Working ..."
'If chkSpace1 Then txtSearch = txtSearch + " "
'If chkSpace2 Then txtNew = txtNew + " "
If Right(txtdirectory, 1) <> "\" Then txtdirectory = txtdirectory + "\"
strFile = txtdirectory & Dir(txtdirectory & "\" & txtFindFiles)
intCount = 0
intTotal = 0
Do While strFile <> txtdirectory
'copy the file to *.old first.
FileCopy strFile, strFile & ".old"

' edit all lines in the file. create a temp file first.
Open strFile & ".old" For Input As #conInput
Open strFile & ".new" For Output As #conOutput

booChanged = funEditFile(conInput, conOutput)

Close #conInput
Close #conOutput

If booChanged Then
Kill strFile
Name strFile & ".new" As strFile
' If chkNoBackup Then
' Kill strFile & ".old"
'End If

intCount = intCount + 1
Else
' Kill strFile & ".new"
' Kill strFile & ".old"
End If

intTotal = intTotal + 1

strFile = txtdirectory & Dir()
txtresult = txtresult & "Scanning [" & Str(intTotal) & "], changed: " &
Str(intCount)
DoEvents
Loop

txtresult = txtresult & "Finished, files changed: " & Str(intCount)

Exit_cmdRenameNow_Click:
Exit Sub

Err_cmdRenameNow_Click:
MsgBox Err.Description
Resume Exit_cmdRenameNow_Click

End Sub


Thanks,
Jack
 
G

Guest

There are two variables that are not referenced in your code, txtNew and
txtSearch, so I would wonder what the values of those variables are. Also,
you have a lot of code to do what the Replace function does for you. For
example, lets assume that txtSearch and txtNew have the correct values in
them:

Do While Not EOF(intInput)
' read one line of text:
Line Input #intInput, strLine
strLine = Replace(strLine, txtSearch, txtNew)
Print #intOutput, strLine
Loop


Jack said:
I found the following code and am having diffculty with the replace portion.
I am hoping someone can take a look and offer any suggestions. It doesnt seem
to find a match from txtsearch tetbox. When I do a debug for strline I
clearly see text. I want to do a replace ALL.

Private Function funEditFile(intInput As Integer, intOutput As Integer) As
Boolean
Dim strLine As String
Dim intPos As Integer
Dim booMatch As Boolean
Dim strNewLine As String
Dim booChanged As Boolean

booChanged = False
Do While Not EOF(intInput)
' read one line of text:
Line Input #intInput, strLine
If Not EOF(intInput) Then

' replace all occurrences of the txtSearch text in strLine:
booMatch = True
intPos = 1
****PROBLEM BEGINS HERE*****
Do While booMatch
intPos = InStr(intPos, strLine, txtSearch)

If ((intPos = 1) And (chkColumn1)) Or _
((intPos > 0) And (Not chkColumn1)) Then
' match found, change it
strLine = Left(strLine, intPos - 1) + txtNew +
Mid(strLine, intPos + Len(txtSearch))
intPos = intPos + Len(txtNew)

booMatch = True
booChanged = True
Else
booMatch = False
End If
Loop

Print #intOutput, strLine
End If
Loop

funEditFile = booChanged
End Function

Private Sub cmdRenameNow_Click()
On Error GoTo Err_cmdRenameNow_Click

Dim stAppName As String
Dim strFile As String
Dim strNewFile As String
Dim intPos As Integer
Const conQuote = 34
Dim intCount As Integer
Dim intTotal As Integer
Dim booChanged As Boolean
Const conInput = 1
Const conOutput = 2

txtresult = "Working ..."
'If chkSpace1 Then txtSearch = txtSearch + " "
'If chkSpace2 Then txtNew = txtNew + " "
If Right(txtdirectory, 1) <> "\" Then txtdirectory = txtdirectory + "\"
strFile = txtdirectory & Dir(txtdirectory & "\" & txtFindFiles)
intCount = 0
intTotal = 0
Do While strFile <> txtdirectory
'copy the file to *.old first.
FileCopy strFile, strFile & ".old"

' edit all lines in the file. create a temp file first.
Open strFile & ".old" For Input As #conInput
Open strFile & ".new" For Output As #conOutput

booChanged = funEditFile(conInput, conOutput)

Close #conInput
Close #conOutput

If booChanged Then
Kill strFile
Name strFile & ".new" As strFile
' If chkNoBackup Then
' Kill strFile & ".old"
'End If

intCount = intCount + 1
Else
' Kill strFile & ".new"
' Kill strFile & ".old"
End If

intTotal = intTotal + 1

strFile = txtdirectory & Dir()
txtresult = txtresult & "Scanning [" & Str(intTotal) & "], changed: " &
Str(intCount)
DoEvents
Loop

txtresult = txtresult & "Finished, files changed: " & Str(intCount)

Exit_cmdRenameNow_Click:
Exit Sub

Err_cmdRenameNow_Click:
MsgBox Err.Description
Resume Exit_cmdRenameNow_Click

End Sub


Thanks,
Jack
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Replace email string in contacts MS Outlook 0

Top