Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #2  
Old 10-15-2015, 12:55 AM
macropod's Avatar
macropod macropod is online now Extract Webdata from word Windows 7 64bit Extract Webdata from word Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,519
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

I've never done much web data retrieval, but here's some code to get you started:
Code:
Sub AddGPHLink()
Dim Rng As Range, StrTxt As String, Tbl As Table, i As Long
Const StrLnk As String = "https://www.google.co.in/patents/"
Dim strLink As String
With ActiveDocument
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = False
      .Forward = True
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Text = "[UECW][SPNO] [0-9]{4,} [A-Z0-9]{1,2}"
      .Replacement.Text = ""
      .Execute
    End With
    Do While .Find.Found
      Set Rng = .Duplicate
      With Rng
        StrTxt = .Text
        .Delete
      End With
      .Hyperlinks.Add Anchor:=Rng, TextToDisplay:=StrTxt, _
        Address:=StrLnk & Replace(StrTxt, " ", "") & "?cl=en"
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
    .Start = ActiveDocument.Range.Start
    With .Find
      .Text = "IN [0-9A-Z]{7,}"
      .Execute
    End With
    Do While .Find.Found
      Set Rng = .Duplicate
      With Rng
        StrTxt = .Text
        .Delete
      End With
      .Hyperlinks.Add Anchor:=Rng, TextToDisplay:=StrTxt, _
        Address:=StrLnk & Replace(StrTxt, " ", "") & "?cl=en"
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
  For Each Tbl In .Tables
    With Tbl
      For i = 1 To .Rows.Count
        StrTxt = ""
        With .Cell(i, 2).Range
          If .Hyperlinks.Count > 0 Then
            StrTxt = Get_URL_Data(.Hyperlinks(1).Address)
          End If
        End With
        .Cell(i, 5).Range.Text = StrTxt
      Next
    End With
  Next
End With
Set Rng = Nothing
End Sub
 
Function Get_URL_Data(StrUrl As String) As String
'References to Internet Explorer & Microsoft HTML required
Dim Browser As SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Dim StrTmp As String, StrTxt As String
Set Browser = New SHDocVw.InternetExplorer
'Open the web page
Browser.navigate StrUrl
Do While Browser.Busy
  DoEvents
Loop
Set HTMLDoc = Browser.Document
Do While Browser.Busy
  DoEvents
Loop
'Get the data
On Error Resume Next
StrTmp = Split(HTMLDoc.Title, " - ")(1)
Get_URL_Data = StrTmp
'Close the browser
Browser.Quit
Set HTMLDoc = Nothing: Set Browser = Nothing
Application.ScreenUpdating = True
End Function
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
 

Tags
macro, website, word 2010

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Extract VBA code to save in Word document Dave T Word VBA 4 01-26-2015 08:41 PM
Extract Webdata from word Need to extract two word domains from a list (BULK) Maxwell314 Excel 3 12-08-2014 06:17 PM
Extract Webdata from word How to Extract key data from word iliauk Word 3 11-08-2013 04:37 PM
Is there a way to extract various text in Word? barnkeeper410 Word 4 07-08-2013 10:58 PM
Extract Webdata from word Extract phone number from word file donlincolnmsof Word VBA 12 06-19-2012 05:21 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 09:50 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft