Solved

Extracting text from a text file

Posted on 1998-09-01
6
225 Views
Last Modified: 2010-04-30
I need to extract certain strings of text from a formatted text file (web addresses). I need to open an existing file extract the info and save into a comma delimeted form. Basically just outputting any web addresses it finds into a text file with quotes around them.
0
Comment
Question by:cliff_martin
  • 4
6 Comments
 
LVL 2

Expert Comment

by:percosolator
ID: 1432436
you haven't specified your problem.
0
 
LVL 3

Accepted Solution

by:
a111a111a111 earned 50 total points
ID: 1432437
Hi, Here is a working code that I made for you.
I you want the completed project you can download it from:
http://www.hili.com/~shay/htmlfile.zip

'============ start  ==========

Option Explicit

Private Sub Command1_Click()
Dim a$
Dim Start As Long
Dim st As Long
Dim ere As Long
Dim f$
Dim Str1$, Str2$
Dim StartTime
Dim EndTime
Dim Rc As RichTextBox
Dim SSS
Set Rc = Rtb    ' Create valid object reference.
Dim OneLine$
Dim AllLines
Dim Wrap

Wrap = Chr$(13) & Chr(10)

Rc = Rtb
f = FreeFile
CommonDialog1.ShowOpen
Open CommonDialog1.filename For Input As f
Rc.Text = Input(LOF(f), f)
Close f

a = Rc.Text
Start = 1
Rc.SelStart = 0
Rc.SelLength = Len(Rtb)
Rc.SelColor = RGB(0, 0, 0)
Rc.SelLength = 0
Rc.Visible = False ' hide richtextbox
Screen.MousePointer = vbHourglass

StartTime = Timer
Do
Str1 = "<A HREF=" & Chr$(34)
Str2 = Chr(34) & ">"
  ere = InStr(Start, a, Str1)
  If ere Then
    Start = ere
  Else
        Exit Do
  End If
   SSS = Chr(34)
  ere = InStr(Start, a, Str2)
  If ere Then
    st = ere
    Rc.SelStart = Start - 1
    Rc.SelLength = st - Start + 1
    Rc.SelColor = QBColor(9)
    If Len(Rc.SelText) > 2 Then
        OneLine = Right(Rc.SelText, Rc.SelLength - 8)
        AllLines = AllLines & OneLine & Wrap
    End If
  Else
    Exit Do
  End If
 
  Start = Start + 1
Loop

Close #1
Text1.Text = AllLines
Screen.MousePointer = vbArrow
Rc.Visible = True
EndTime = Timer
MsgBox "Done  " & EndTime - StartTime

End Sub

' ========== end ===========

shay@hili.com
0
 

Author Comment

by:cliff_martin
ID: 1432438
This Looks Like it will work. Forgive me for not stating my problem. Problem: I'm Dumb. Actuall I am a VB newbie and I was just looking for a sample that I can learn from while accomplishing my task. Thanks...
0
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 
LVL 3

Expert Comment

by:a111a111a111
ID: 1432439
Additions.

Hi,
I add 2 more functions to the "Project".
1. Auto save in case you overwrite the original file (HTML or so.)
2. Create a new file with the results (You specify the file name.)

'=========== Start ============

Option Explicit

Private Sub Command1_Click()
Dim a$
Dim Start As Long
Dim st As Long
Dim ere As Long
Dim f$
Dim Str1$, Str2$
Dim StartTime
Dim EndTime
Dim Rc As RichTextBox

Set Rc = Rtb    ' Create valid object reference.
Dim OneLine$
Dim AllLines
Dim Wrap
On Error Resume Next

Wrap = Chr$(13) & Chr(10)

Rc = Rtb
f = FreeFile
CommonDialog1.ShowOpen
Open CommonDialog1.filename For Input As f

FileCopy CommonDialog1.filename, "Autosave.txt" ' this is auto save in case you made a mistake and overwrite your original file.

Rc.Text = Input(LOF(f), f)
Close f

a = Rc.Text
Start = 1
Rc.SelStart = 0
Rc.SelLength = Len(Rtb)
Rc.SelColor = RGB(0, 0, 0)
Rc.SelLength = 0
Rc.Visible = False ' hide richtextbox
Screen.MousePointer = vbHourglass

StartTime = Timer
Do
Str1 = "<A HREF=" & Chr$(34)
Str2 = Chr(34) & ">"
  ere = InStr(Start, a, Str1)
  If ere Then
    Start = ere
  Else
        Exit Do
  End If
 
  ere = InStr(Start, a, Str2)
  If ere Then
    st = ere
    Rc.SelStart = Start - 1
    Rc.SelLength = st - Start + 1
    Rc.SelColor = QBColor(9)
   
    If Len(Rc.SelText) > 2 Then
        OneLine = Right(Rc.SelText, Rc.SelLength - 8)
        AllLines = AllLines & OneLine & Wrap
    End If
  Else
    Exit Do
  End If
 
  Start = Start + 1
Loop

Close
Text1.Text = AllLines
Screen.MousePointer = vbArrow
Rc.Visible = True
EndTime = Timer
MsgBox "Click OK now and then type the name of the file you want to Save As"
CommonDialog1.ShowOpen
Open CommonDialog1.filename For Output As f
Print #f, Text1.Text
Close
MsgBox "Done  " & EndTime - StartTime & "  In Seconds"
End Sub

'============End =============

Also the complete Project is at: www.hili.com/~shay/htmlfile.zip

The zip file contained an EXE file for use to any user/Programmer that not having VB 5.0 compiler.

Shay@hili.com

0
 
LVL 3

Expert Comment

by:a111a111a111
ID: 1432440
OKay well I just add a comment and I saw you gave me the points and some of "your comments"

In any case I'll be happy to assist you at any time.
Just Email to shay@hili.com with your question/s.

Thanks again.

BTW is was fun.

0
 
LVL 3

Expert Comment

by:a111a111a111
ID: 1432441
Hi again.

Well for a newbie I will recommend for you to make a function from the selected
code that I posted here.

Remember backup your code every time you made a big modification.

The project is as an example only i.e. "Form1" , "Project1" and so.
It is NOT the way to write programs, But it is as is in order to give you a chance to change it name and make it clear.

Shay
0

Featured Post

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Problem to skip loop 6 57
Updates not working for MS Windows 7 12 164
Crystal reports - Formula Field code need assistance with code 17 69
Add a task in Outlook from access 11 39
Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

776 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question