Access VBA Code to execute find/replace in .csv files

  • Thread starter Thread starter Guest
  • Start date Start date
I made a general string replaces, which can handle multiple files at once.
I am sure it will not solve your problem, but you might find it useful as a
starter.

The form contains the following items:
txtDirectory, txtFindFiles, txtChange, txtNew all text input field.
chkSpace1, chkSpace2 two check boxes, which indicate that a space is to be
added on the end of the txtChange and txtNew fields.
txtResult a text output field
cmdRenameNow a command button.

The code in this form is:
Option Compare Database
Option Explicit

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
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 = "Scanning [" & Str(intTotal) & "], changed: " &
Str(intCount)
DoEvents
Loop

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

Exit_cmdRenameNow_Click:
Exit Sub

Err_cmdRenameNow_Click:
MsgBox Err.Description
Resume Exit_cmdRenameNow_Click

End Sub
 
Thanks Edwin. Were getting closer. However, I was looking for something more
along the lines of executing the following: Also note: I am not sure how to
do this via Access... This is all that needs to happen. I have code to loop
through the folders and open each .csv file and now if I have to I could save
the file as an Excel sheet then perform the following code and then save it
back as a .csv or just leave it as an Excel sheet to be imported into the
Access either way I know that the solutions is possible I am just not sure
how to write it... Do you see what I mean?
I am looking for a way to ececute this in either Excel or .csv via Access
vba code...


Sub RemoveCommas()
Cells.Select
Selection.Replace What:=",", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End Sub

--
~ SPARKER ~


Edwin van Ree said:
I made a general string replaces, which can handle multiple files at once.
I am sure it will not solve your problem, but you might find it useful as a
starter.

The form contains the following items:
txtDirectory, txtFindFiles, txtChange, txtNew all text input field.
chkSpace1, chkSpace2 two check boxes, which indicate that a space is to be
added on the end of the txtChange and txtNew fields.
txtResult a text output field
cmdRenameNow a command button.

The code in this form is:
Option Compare Database
Option Explicit

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
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 = "Scanning [" & Str(intTotal) & "], changed: " &
Str(intCount)
DoEvents
Loop

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

Exit_cmdRenameNow_Click:
Exit Sub

Err_cmdRenameNow_Click:
MsgBox Err.Description
Resume Exit_cmdRenameNow_Click

End Sub


sparker said:
Looking for example of :
Access VBA Code to execute find/replace in .csv files
Click to expand...
Click to expand...
 
Ok people I have written the code. It took me awhile but it is complete and
accurate. If anybody has had a similar task to complete here is the quick an
easy. Also Note: Thanks to everybody that made an attempt to help me I do
appreciate it. Take Care & God Bless ~ Sparker
Oh ... here is the code I wrote enjoy!

Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Dim strPath As String
Dim strFile As String
Dim strOldName As String
Dim strNewName As String
Set oExcel = CreateObject("Excel.Application")
strPath = "C:\CSV_Files\Objects Reports\"
strFile = Dir(strPath & "\*.csv")
Do While strFile <> ""

strOldName = strPath & strFile

Set oBook = oExcel.Workbooks.Open(strOldName)

Cells.Select

Selection.Replace _
What:=",", _
Replacement:=" ", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False

oExcel.DisplayAlerts = False
oBook.SaveAs strOldName
oExcel.Quit
oExcel.DisplayAlerts = True

DoCmd.TransferText acImportDelim, "CSV_ImportSpec", "tblNewCSV", strPath
& strFile
--
~ SPARKER ~


sparker said:
Thanks Edwin. Were getting closer. However, I was looking for something more
along the lines of executing the following: Also note: I am not sure how to
do this via Access... This is all that needs to happen. I have code to loop
through the folders and open each .csv file and now if I have to I could save
the file as an Excel sheet then perform the following code and then save it
back as a .csv or just leave it as an Excel sheet to be imported into the
Access either way I know that the solutions is possible I am just not sure
how to write it... Do you see what I mean?
I am looking for a way to ececute this in either Excel or .csv via Access
vba code...


Sub RemoveCommas()
Cells.Select
Selection.Replace What:=",", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End Sub

--
~ SPARKER ~


Edwin van Ree said:
I made a general string replaces, which can handle multiple files at once.
I am sure it will not solve your problem, but you might find it useful as a
starter.

The form contains the following items:
txtDirectory, txtFindFiles, txtChange, txtNew all text input field.
chkSpace1, chkSpace2 two check boxes, which indicate that a space is to be
added on the end of the txtChange and txtNew fields.
txtResult a text output field
cmdRenameNow a command button.

The code in this form is:
Option Compare Database
Option Explicit

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
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 = "Scanning [" & Str(intTotal) & "], changed: " &
Str(intCount)
DoEvents
Loop

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

Exit_cmdRenameNow_Click:
Exit Sub

Err_cmdRenameNow_Click:
MsgBox Err.Description
Resume Exit_cmdRenameNow_Click

End Sub


sparker said:
Looking for example of :
Access VBA Code to execute find/replace in .csv files
Click to expand...
Click to expand...
Click to expand...
 
Back
Top