Get data from a webpage 1

[MrMajik]

I searched the VB6 help files and the Internet and can't find any information on how to do this. Maybe you know how to do this:

I want my VB6 code to go to a web page and download just a piece (table) from the website into a new text file.

Microsoft Excel will get the data from the website table using the New Web Query from Get External Data from the Data menu. I located the query file but it was not any help. So I created a new Web Query while recording the macro. I could not get the VB code that the macro generated to work in my VB program.

Do you know how to do this?

Thank you.

MrMajik

Everything should be made as simple as possible, but not simpler
--Albert Einstein

 

[koala15]

Two suggestions:

1. Re-Post your question in the VBA forum,

2. Have you tried FTP'ing the Web Page to your App using VB (I assume you know the URL) and then disecting the HTML.

Does that make sense?

"Life is full of learning, and then there is wisdom"

 

[MrMajik]

koala15,

I wasn't real sure where to post this question. Thank you for the suggestion. I will take it there. In the meantime, I may be able to use your FTP idea. I use ShellExecute to send URL's to the browser. Never considered FTPing something using VB code. Can you offer a snippet of code to get me going?

Thank you.

MrMajik

Everything should be made as simple as possible, but not simpler
--Albert Einstein

 

[durda]

MrM.
could'nt be easier if you utilize the webbrowser. try the following.

This will strip all tags for you.....

Option Explicit

Private Sub Form_Load()
WebBrowser1.Navigate "

http://www.yahoo.com"

End Sub

Private Sub Command1_Click()
Text1.Text = WebBrowser1.Document.body.innerText
End Sub

of course you have to add webbrowser1 from components, and don't try to run the event in command1_click on form_load otherwise it will error out. now this is utilizing a textbox (so dont forget to set the multiline property to true on the textbox properties, otherwise it will write everything to one line), just re-code to point it toward a txt file instead.

hope this helps)

 

[koala15]

durda,

Good one!!!!!

"Life is full of learning, and then there is wisdom"

 

[SemperFiDownUnda]

I've got a program I use for these forums that does what you want.

It loads the web page into a browser control and with a touch of a button will dump just the thread text (with or without signatures) to a text box. It also uses Text to speach to read the thread back to you.

I'll make a FAQ for it maybe.


Hope I've been helpful,
Wayne Francis

If you want to get the best response to a question, please check out FAQ222-2244 first

 

[SemperFiDownUnda]

I decided to just put the code here.
Agian does more then you want but...
Project needs 2 references.
1 MS Internet controls
and
2 MS Speech Object Library

Its not great .... just something I hacked together in about 15-20 minutes so I could listen to posts while working.

VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain 
   Appearance      =   0  'Flat
   Caption         =   "Form1"
   ClientHeight    =   12015
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10875
   LinkTopic       =   "Form1"
   ScaleHeight     =   12015
   ScaleWidth      =   10875
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdStop 
      Appearance      =   0  'Flat
      Caption         =   "Stop"
      Height          =   315
      Left            =   7800
      TabIndex        =   20
      Top             =   360
      Width           =   855
   End
   Begin VB.CommandButton cmdSVS 
      Caption         =   "Show Voice Settings"
      Height          =   315
      Left            =   6000
      TabIndex        =   11
      Top             =   360
      Width           =   1695
   End
   Begin VB.CommandButton cmdSpeak 
      Appearance      =   0  'Flat
      Caption         =   "Speak"
      Height          =   315
      Left            =   5040
      TabIndex        =   10
      Top             =   360
      Width           =   855
   End
   Begin VB.OptionButton optView 
      Caption         =   "Web Outline"
      Height          =   315
      Index           =   2
      Left            =   3840
      TabIndex        =   9
      Top             =   360
      Width           =   1215
   End
   Begin VB.OptionButton optView 
      Caption         =   "Text Post"
      Height          =   315
      Index           =   1
      Left            =   2880
      TabIndex        =   8
      Top             =   360
      Width           =   975
   End
   Begin VB.OptionButton optView 
      Caption         =   "Web Page"
      Height          =   315
      Index           =   0
      Left            =   1800
      TabIndex        =   7
      Top             =   360
      Value           =   -1  'True
      Width           =   1095
   End
   Begin VB.CheckBox chkRemoveSig 
      Caption         =   "Remove Signature"
      Height          =   255
      Left            =   0
      TabIndex        =   6
      Top             =   360
      Value           =   1  'Checked
      Width           =   1695
   End
   Begin VB.CommandButton cmdSearch 
      Appearance      =   0  'Flat
      Caption         =   "Transfer"
      Height          =   315
      Left            =   8760
      TabIndex        =   4
      Top             =   360
      Width           =   855
   End
   Begin VB.CommandButton cmdGo 
      Appearance      =   0  'Flat
      Caption         =   "Go"
      Height          =   315
      Left            =   10200
      TabIndex        =   2
      Top             =   0
      Width           =   615
   End
   Begin VB.TextBox txtURL 
      Appearance      =   0  'Flat
      Height          =   315
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   10215
   End
   Begin SHDocVwCtl.WebBrowser wbPage 
      Height          =   4335
      Left            =   0
      TabIndex        =   0
      Top             =   1440
      Width           =   10575
      ExtentX         =   18653
      ExtentY         =   7646
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      NoWebView       =   0   'False
      HideFileNames   =   0   'False
      SingleClick     =   0   'False
      SingleSelection =   0   'False
      NoFolders       =   0   'False
      Transparent     =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   "[URL unfurl="true"]http:///"[/URL]
   End
   Begin MSComctlLib.TreeView tvPage 
      Height          =   615
      Left            =   1920
      TabIndex        =   5
      Top             =   3960
      Width           =   2295
      _ExtentX        =   4048
      _ExtentY        =   1085
      _Version        =   393217
      HideSelection   =   0   'False
      Indentation     =   370
      LabelEdit       =   1
      LineStyle       =   1
      Style           =   7
      Appearance      =   0
   End
   Begin RichTextLib.RichTextBox txtPost 
      Height          =   2895
      Left            =   0
      TabIndex        =   3
      Top             =   1080
      Width           =   4935
      _ExtentX        =   8705
      _ExtentY        =   5106
      _Version        =   393217
      ScrollBars      =   2
      Appearance      =   0
      TextRTF         =   $"frmMain.frx":0000
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSComctlLib.Slider sldSpeed 
      Height          =   255
      Left            =   600
      TabIndex        =   13
      Top             =   720
      Width           =   1455
      _ExtentX        =   2566
      _ExtentY        =   450
      _Version        =   393216
      LargeChange     =   2
      Min             =   -10
      SelStart        =   10
      Value           =   10
   End
   Begin MSComctlLib.Slider sldVol 
      Height          =   255
      Left            =   2640
      TabIndex        =   15
      Top             =   720
      Width           =   1455
      _ExtentX        =   2566
      _ExtentY        =   450
      _Version        =   393216
      LargeChange     =   10
      Min             =   1
      Max             =   100
      SelStart        =   100
      TickFrequency   =   10
      Value           =   100
   End
   Begin MSComctlLib.Slider sldPitch 
      Height          =   255
      Left            =   4680
      TabIndex        =   17
      Top             =   720
      Width           =   1455
      _ExtentX        =   2566
      _ExtentY        =   450
      _Version        =   393216
      LargeChange     =   10
      Min             =   -80
      Max             =   100
      TickFrequency   =   10
   End
   Begin VB.ComboBox cboVoice 
      Height          =   315
      Left            =   6720
      Style           =   2  'Dropdown List
      TabIndex        =   19
      Top             =   720
      Width           =   1215
   End
   Begin MSComctlLib.ProgressBar pbAudioLevel 
      Height          =   315
      Left            =   0
      TabIndex        =   21
      Top             =   1080
      Width           =   10815
      _ExtentX        =   19076
      _ExtentY        =   556
      _Version        =   393216
      BorderStyle     =   1
      Appearance      =   0
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "Speed"
      Height          =   315
      Index           =   0
      Left            =   0
      TabIndex        =   12
      Top             =   720
      Width           =   495
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "Vol"
      Height          =   315
      Index           =   1
      Left            =   2160
      TabIndex        =   14
      Top             =   720
      Width           =   495
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "Pitch"
      Height          =   315
      Index           =   2
      Left            =   4080
      TabIndex        =   16
      Top             =   720
      Width           =   495
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "Voice"
      Height          =   315
      Index           =   3
      Left            =   6120
      TabIndex        =   18
      Top             =   720
      Width           =   495
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private lID As Long
Dim sSignature As String
Dim WithEvents sVoice As SpeechLib.SpVoice
Attribute sVoice.VB_VarHelpID = -1
Dim bBeenPaused As Boolean
Dim sStart As Long
Dim sSentanceStart As Long
Dim sSentanceLen As Long
Dim sWordStart As Long
Dim sWordEnd As Long

Private Sub cboVoice_Click()
  SaveSetting "PostReader", "Settings", "VoiceNum", cboVoice.ListIndex
End Sub

Private Sub cmdGo_Click()
  cmdSpeak.Enabled = False
  wbPage.Navigate txtURL.Text
End Sub

Private Sub cmdSearch_Click()
  Dim obj
  Dim iLvl As Integer
  txtPost.Text = ""
  lID = 0
  tvPage.Nodes.Clear
  iLvl = 1
  For Each obj In wbPage.Document.body.Children
    lID = lID + 1
    tvPage.Nodes.Add , , "ID" & CStr(lID), obj.tagName
    AddChildren obj, lID, iLvl + 1
  Next
  Dim nNode As MSComctlLib.Node
  tvPage.Visible = False
  For Each nNode In tvPage.Nodes
    nNode.Expanded = True
  Next
  tvPage.Visible = True
End Sub

Private Sub AddChildren(obj, ByVal ParentID As Long, ByVal iLvl As Integer)
  Dim sTagName As String
  Dim sPost As String
  Dim cObj
  Dim iChildInLevel As Integer
  iChildInLevel = 1
  For Each cObj In obj.Children
    lID = lID + 1
    sTagName = cObj.tagName
    
    tvPage.Nodes.Add "ID" & CStr(ParentID), tvwChild, "ID" & CStr(lID), sTagName & " : " & CStr(iLvl) & " : " & Left(cObj.innerText, 50)
    AddChildren cObj, lID, iLvl + 1
    If iLvl = 17 And _
       (StrComp(sTagName, "table", vbTextCompare) = 0) And _
       iChildInLevel <= 2 Then
        sPost = cObj.innerText
        If iChildInLevel = 2 And _
           chkRemoveSig.Value = vbChecked Then
           If sSignature <> "" Then
            sPost = Left(sPost, InStrRev(sPost, sSignature, , vbTextCompare) - 1)
          End If
        End If
        txtPost.Text = txtPost.Text & sPost & vbNewLine
        sSignature = ""
    Else
      If iLvl = 21 And _
         (StrComp(sTagName, "P", vbTextCompare) = 0) Then
        sSignature = cObj.innerText
      End If
    End If
    iChildInLevel = iChildInLevel + 1
  Next
End Sub

Private Sub cmdSpeak_Click()
  Dim sText As String
  If cmdSpeak.Caption = "Speak" Then
    If sVoice Is Nothing Then
      Exit Sub
    End If
    cmdSpeak.Caption = "Pause"
    If bBeenPaused Then
      sVoice.Resume
    Else
      Set sVoice.Voice = sVoice.GetVoices.Item(cboVoice.ListIndex)
      sVoice.Rate = sldSpeed.Value
      sVoice.Volume = sldVol.Value
      'sVoice.Speak "Test 3"
      'sText = "<PITCH MIDDLE=""" & IIf(sldPitch.Value > 0, "+", "") & CStr(sldPitch.Value) & """>"
      'sText = sText & "Test 4"
      sText = "<PITCH MIDDLE=""" & IIf(sldPitch.Value > 0, "+", "") & CStr(sldPitch.Value) & """>"
      If txtPost.SelLength = 0 Then
        txtPost.SelStart = 1
        txtPost.SelLength = Len(txtPost.Text)
      End If
      sStart = txtPost.SelStart
      sText = sText & Mid(txtPost.Text, txtPost.SelStart + 1, txtPost.SelLength)
      sVoice.Speak sText, SVSFlagsAsync
    End If
  Else
    bBeenPaused = True
    sVoice.Pause
    cmdSpeak.Caption = "Speak"
  End If
End Sub

Private Sub loadVoices()
  Set sVoice = CreateObject("SAPI.SpVoice")
  If sVoice Is Nothing Then
    cmdSpeak.Enabled = False
    Exit Sub
  End If
  Dim lngVoiceCounter As Long
  For lngVoiceCounter = 0 To sVoice.GetVoices.Count - 1
    cboVoice.AddItem sVoice.GetVoices.Item(lngVoiceCounter).GetDescription
    'Set sVoice.Voice = sVoice.GetVoices.Item(lngVoiceCounter)
    'sVoice.Speak sVoice.GetVoices.Item(lngVoiceCounter).GetDescription, SVSFDefault
  Next
  Dim iVoice As Long
  iVoice = CLng(GetSetting("PostReader", "Settings", "VoiceNum", "0"))
  If iVoice > sVoice.GetVoices.Count Then
    iVoice = 0
  End If
  Set sVoice.Voice = sVoice.GetVoices.Item(iVoice)

  cboVoice.ListIndex = iVoice
  sVoice.EventInterests = SVEAllEvents
End Sub

Private Sub cmdStop_Click()
  sVoice.Speak "Stopped", SVSFPurgeBeforeSpeak
  cmdSpeak.Caption = "Speak"
  bBeenPaused = False
End Sub

Private Sub cmdSVS_Click()
    If cmdSVS.Caption = "Show Voice Settings" Then
      cmdSVS.Caption = "Hide Voice Settings"
    Else
      cmdSVS.Caption = "Show Voice Settings"
    End If
    Form_Resize
End Sub

Private Sub Form_Load()
  Dim sURL As String
  sURL = GetSetting("PostReader", "Settings", "LASTURL", "[URL unfurl="true"]http://www.tek-tips.com/threadhome.cfm?tp=1")[/URL]
  txtURL.Text = sURL
  loadVoices
  sldSpeed.Value = GetSetting("PostReader", "Settings", "Speed", "150")
  sldVol.Value = GetSetting("PostReader", "Settings", "Vol", "100")
  sldPitch.Value = GetSetting("PostReader", "Settings", "Pitch", "0")
End Sub

Private Sub Form_Resize()
  Dim sldWidth As Long
  If Me.WindowState <> vbMinimized Then
    If Me.Height < 2100 Then Me.Height = 2100
    If Me.Width < 9000 Then Me.Width = 9000
    If cmdSVS.Caption = "Show Voice Settings" Then
      wbPage.Top = cmdSVS.Top + 315
    Else
      wbPage.Top = cmdSVS.Top + 1065
    End If
    txtURL.Width = Me.ScaleWidth - cmdGo.Width
    cmdGo.Left = Me.ScaleWidth - cmdGo.Width
    pbAudioLevel.Width = Me.ScaleWidth
    wbPage.Width = Me.ScaleWidth
    wbPage.Height = Me.ScaleHeight - wbPage.Top
    txtPost.Top = wbPage.Top
    txtPost.Left = 0
    txtPost.Width = Me.ScaleWidth
    txtPost.Height = wbPage.Height
    tvPage.Left = 0
    tvPage.Top = txtPost.Top
    tvPage.Width = Me.ScaleWidth
    tvPage.Height = wbPage.Height
    sldWidth = (Me.ScaleWidth - (525 * 4)) / 4
    sldSpeed.Width = sldWidth
    sldVol.Width = sldWidth
    sldPitch.Width = sldWidth
    cboVoice.Width = sldWidth
    Label1(1).Left = sldSpeed.Left + sldWidth
    sldVol.Left = Label1(1).Left + 495
    Label1(2).Left = sldVol.Left + sldWidth
    sldPitch.Left = Label1(2).Left + 495
    Label1(3).Left = sldPitch.Left + sldWidth
    cboVoice.Left = Label1(3).Left + 495
    
  End If
End Sub

Private Sub optView_Click(Index As Integer)
  Select Case Index
    Case Is = 0
      wbPage.ZOrder 0
    Case Is = 1
      txtPost.ZOrder 0
    Case Is = 2
      tvPage.ZOrder 0
  End Select
  
End Sub

Private Sub sVoice2_Sentence(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal CharacterPosition As Long, ByVal Length As Long)

End Sub

Private Sub sVoice2_StartStream(ByVal StreamNumber As Long, ByVal StreamPosition As Variant)

End Sub

Private Sub sldPitch_Change()
  SaveSetting "PostReader", "Settings", "Pitch", sldPitch.Value
End Sub

Private Sub sldSpeed_Change()
  SaveSetting "PostReader", "Settings", "Speed", sldSpeed.Value
  sVoice.Rate = sldSpeed.Value
  'sVoice.Speak "Rate is " & CStr(sldSpeed.Value)
End Sub

Private Sub sldVol_Change()
  SaveSetting "PostReader", "Settings", "Vol", sldVol.Value
  sVoice.Volume = sldVol.Value
End Sub

Private Sub sVoice_AudioLevel(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal AudioLevel As Long)
  pbAudioLevel.Value = AudioLevel
End Sub

Private Sub sVoice_EndStream(ByVal StreamNumber As Long, ByVal StreamPosition As Variant)
  cmdSpeak.Caption = "Speak"
  ClearVariables
  bBeenPaused = False
End Sub

Private Sub ClearVariables()
  sStart = 0
  sSentanceStart = 0
  sSentanceLen = 0
  sWordStart = 0
  sWordEnd = 0
End Sub

Private Sub sVoice_Sentence(ByVal StreamNumber As Long, _
                            ByVal StreamPosition As Variant, _
                            ByVal CharacterPosition As Long, _
                            ByVal Length As Long)
  If CharacterPosition = 0 Then
    Exit Sub
  End If
  If Length < 1 Then
    Exit Sub
  End If
  txtPost.SelStart = sSentanceStart
  txtPost.SelLength = sSentanceLen
  txtPost.SelItalic = False
  txtPost.SelColor = 0
  sSentanceStart = sStart + CharacterPosition - 18
  If sSentanceStart < 0 Then
    ClearVariables
    Exit Sub
  End If
  sSentanceLen = Length
  txtPost.SelStart = sSentanceStart
  txtPost.SelLength = sSentanceLen
  txtPost.SelItalic = True
  txtPost.SelColor = RGB(0, 0, 192)
End Sub

Private Sub sVoice_Word(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal CharacterPosition As Long, ByVal Length As Long)
  txtPost.SelStart = sWordStart
  txtPost.SelLength = sWordEnd
  txtPost.SelBold = False
  sWordStart = sStart + CharacterPosition - 18
  If sWordStart < 0 Then
    ClearVariables
    Exit Sub
  End If
  sWordEnd = Length
  txtPost.SelStart = sWordStart
  txtPost.SelLength = sWordEnd
  txtPost.SelBold = True
End Sub

Private Sub wbPage_DownloadComplete()
  If wbPage.LocationURL = "[URL unfurl="true"]http:///"[/URL] Then
    Exit Sub
  End If
  txtURL.Text = wbPage.LocationURL
  Dim sTmp As String
  sTmp = txtURL.Text
  Replace sTmp, "/", "|"
  SaveSetting "PostReader", "Settings", "LASTURL", sTmp
  sVoice.Speak "Page Download complete", SVSFDefault
  
  'cmdSearch_Click
  cmdSpeak.Enabled = True
End Sub

Hope I've been helpful,
Wayne Francis

If you want to get the best response to a question, please check out FAQ222-2244 first

 

[MrMajik]

Thank You! to ALL who responded with code and ideas.

Durda,

Your solution is so simple and does exactly what I am looking for. Here's your star

Thank you.

MrMajik

Everything should be made as simple as possible, but not simpler
--Albert Einstein

 

[flynbye]

This was VERY interesting but for some reason this code doesn't want to work in my form? Working with VB 6.0 and created a blank form and pretty much copied your code into it but what I'm finding is that the objects and the Begin form descriptions are coming up in error (red) is this something I am doing? I did double check to be sure that the references are available for both MS Internet Controls and MS speech library. Should I be doing something specific when creating the form?

Thanks,

I always makes things much harder than they should be... that way later I can slap myself in the forhead after spending hours and hours on two lines of code and say to myself "DUH!"

 

[MrMajik]

flynbye,

In VB 6 click Projects | Components Under the Controls tab locate and put a check by Microsoft Internet Controls

Hope this helps.

Thank you.

MrMajik

Everything should be made as simple as possible, but not simpler
--Albert Einstein

 

[BogdanMBM]

flynbye ,

All that stuff that appears to you in red is bechause you should not create a new form from VB6 interface. Just copy/paste that code into notepad and save it with .frm extension.
If you create a new form, save it and then open it with notepad you'll see all that stuff at the begining of the file. VB6 does all this authomaticly for you.
If you want to do it from VB6, just skip that part from the post of SemperFiDownUnda.