Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
J@Y J@Y is offline
external usenet poster
 
Posts: 127
Default Code for searching & copying Text from 1 text file to another

This is quite out of my league. I am trying to get a set of code that would:
1. In a text file, Search line by line for a keyword or number (most likely
part of a sentence)
2. From the line where the 1st keyword/number was found, search again line
by line for another keyword/number
3. When the 2nd keyword is found, copy the contents between the lines
containing the two keywords to another text file
4. Loop the process for N sets of keywords

Thanks
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 6,953
Default Code for searching & copying Text from 1 text file to another

http://msdn.microsoft.com/library/en...ce09072000.asp
Working with Files, Folders and Drives: More VBA Tips and Tricks by David
Shank

http://support.microsoft.com/default...b;en-us;151262
Working with Sequential Access Files

http://www.applecore99.com/gen/gen029.asp

Reading and Writing
http://msdn2.microsoft.com/en-us/library/czxefwt8.aspx

----------- Sample code to read a file --------------

Sub ReadStraightTextFile()
Dim sStr as String
Dim LineofText As String
Dim rw as Long
rw = 0
Open "C:\FILEIO\TEXTFILE.TXT" For Input As #1
sStr = ""
Do While Not EOF(1)
Line Input #1, LineofText
sStr = sStr & lineofText
if len(sStr) = 178 then
rw = rw + 1
cells(rw,1).Value = sStr
sStr = ""
End if
Loop
'Close the file
if len(sStr) 0 then
cells(rw,1).Value = sStr
End if
Close #1
End Sub

------- Some code by Jake Marx --------
function to truncate a file at a given test string (including the test string)

Private Const mlTEMP_FOLDER As Long = 2

Public Function gbTruncateFile(rsFullPath As String, _
rsTruncString As String) As Boolean
Dim fso As Object
Dim tsSrc As Object
Dim tsDest As Object
Dim bDone As Boolean
Dim sTemp As String
Dim lTruncPos As Long
Dim sDestPath As String

On Error GoTo ErrHandler

Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(rsFullPath) Then
Set tsSrc = fso.OpenTextFile(rsFullPath)
sDestPath = fso.GetSpecialFolder(mlTEMP_FOLDER) _
& Application.PathSeparator & fso.GetFileName(rsFullPath)
Set tsDest = fso.CreateTextFile(sDestPath, True)
With tsSrc
Do While Not (.AtEndOfStream Or bDone)
sTemp = .ReadLine
lTruncPos = InStr(1, sTemp, rsTruncString, _
vbTextCompare)
If lTruncPos Then
sTemp = Left$(sTemp, lTruncPos - 1)
bDone = True
End If
tsDest.WriteLine sTemp
Loop
End With

tsSrc.Close
tsDest.Close

fso.CopyFile sDestPath, rsFullPath, True

gbTruncateFile = True
End If

ExitRoutine:
On Error Resume Next
tsSrc.Close
tsDest.Close
Kill sDestPath
Set tsSrc = Nothing
Set tsDest = Nothing
Set fso = Nothing
Exit Function
ErrHandler:
Resume ExitRoutine
End Function

-------------------------------------

Sample code if you wanted to read the entire file into a variable:

Sub fdsa()
Dim FileNumber As Integer, FilePath As String
Dim FullString As String
FilePath = "C:\Export.txt"
FileNumber = FreeFile
Open FilePath For Input As #FileNumber
FileLength = LOF(FileNumber)
Do While Not EOF(FileNumber)
Line Input #FileNumber, FullString
MsgBox FullString, vbInformation + vbOKOnly

Loop
Close #FileNumber
End Sub

You should be able to coble something together.

--
Regards,
Tom Ogilvy


"J@Y" wrote:

This is quite out of my league. I am trying to get a set of code that would:
1. In a text file, Search line by line for a keyword or number (most likely
part of a sentence)
2. From the line where the 1st keyword/number was found, search again line
by line for another keyword/number
3. When the 2nd keyword is found, copy the contents between the lines
containing the two keywords to another text file
4. Loop the process for N sets of keywords

Thanks

  #3   Report Post  
Posted to microsoft.public.excel.programming
J@Y J@Y is offline
external usenet poster
 
Posts: 127
Default Code for searching & copying Text from 1 text file to another

Great thanks! I was looking for specific tutorials like these

"Tom Ogilvy" wrote:

http://msdn.microsoft.com/library/en...ce09072000.asp
Working with Files, Folders and Drives: More VBA Tips and Tricks by David
Shank

http://support.microsoft.com/default...b;en-us;151262
Working with Sequential Access Files

http://www.applecore99.com/gen/gen029.asp

Reading and Writing
http://msdn2.microsoft.com/en-us/library/czxefwt8.aspx

----------- Sample code to read a file --------------

Sub ReadStraightTextFile()
Dim sStr as String
Dim LineofText As String
Dim rw as Long
rw = 0
Open "C:\FILEIO\TEXTFILE.TXT" For Input As #1
sStr = ""
Do While Not EOF(1)
Line Input #1, LineofText
sStr = sStr & lineofText
if len(sStr) = 178 then
rw = rw + 1
cells(rw,1).Value = sStr
sStr = ""
End if
Loop
'Close the file
if len(sStr) 0 then
cells(rw,1).Value = sStr
End if
Close #1
End Sub

------- Some code by Jake Marx --------
function to truncate a file at a given test string (including the test string)

Private Const mlTEMP_FOLDER As Long = 2

Public Function gbTruncateFile(rsFullPath As String, _
rsTruncString As String) As Boolean
Dim fso As Object
Dim tsSrc As Object
Dim tsDest As Object
Dim bDone As Boolean
Dim sTemp As String
Dim lTruncPos As Long
Dim sDestPath As String

On Error GoTo ErrHandler

Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(rsFullPath) Then
Set tsSrc = fso.OpenTextFile(rsFullPath)
sDestPath = fso.GetSpecialFolder(mlTEMP_FOLDER) _
& Application.PathSeparator & fso.GetFileName(rsFullPath)
Set tsDest = fso.CreateTextFile(sDestPath, True)
With tsSrc
Do While Not (.AtEndOfStream Or bDone)
sTemp = .ReadLine
lTruncPos = InStr(1, sTemp, rsTruncString, _
vbTextCompare)
If lTruncPos Then
sTemp = Left$(sTemp, lTruncPos - 1)
bDone = True
End If
tsDest.WriteLine sTemp
Loop
End With

tsSrc.Close
tsDest.Close

fso.CopyFile sDestPath, rsFullPath, True

gbTruncateFile = True
End If

ExitRoutine:
On Error Resume Next
tsSrc.Close
tsDest.Close
Kill sDestPath
Set tsSrc = Nothing
Set tsDest = Nothing
Set fso = Nothing
Exit Function
ErrHandler:
Resume ExitRoutine
End Function

-------------------------------------

Sample code if you wanted to read the entire file into a variable:

Sub fdsa()
Dim FileNumber As Integer, FilePath As String
Dim FullString As String
FilePath = "C:\Export.txt"
FileNumber = FreeFile
Open FilePath For Input As #FileNumber
FileLength = LOF(FileNumber)
Do While Not EOF(FileNumber)
Line Input #FileNumber, FullString
MsgBox FullString, vbInformation + vbOKOnly

Loop
Close #FileNumber
End Sub

You should be able to coble something together.

--
Regards,
Tom Ogilvy


"J@Y" wrote:

This is quite out of my league. I am trying to get a set of code that would:
1. In a text file, Search line by line for a keyword or number (most likely
part of a sentence)
2. From the line where the 1st keyword/number was found, search again line
by line for another keyword/number
3. When the 2nd keyword is found, copy the contents between the lines
containing the two keywords to another text file
4. Loop the process for N sets of keywords

Thanks

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
searching a text file and importing selected data brian Excel Discussion (Misc queries) 0 October 30th 07 08:44 PM
searching and copying text in drawing layer of excel? jeffery Excel Discussion (Misc queries) 3 November 10th 06 04:41 PM
copying text via linked cell from combo box to macro code pagelocator Excel Programming 0 November 16th 04 09:04 AM
Copying text file into worksheet No Name Excel Programming 1 October 11th 04 04:56 AM
Searching multiple files and copying text Marcelo P. Excel Programming 0 July 23rd 04 08:30 PM


All times are GMT +1. The time now is 08:43 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"