Input Cell Data Into Internet Form

[DrMingle]

This code is a snippet of a previous code that I received help on from tek-tips. I recently converted to the newest version of IE which created a few problems. For whatever reason the text from "Address = Range("I11").Text" dumps in the address bar not in the field "address" on the internet form any more.

Secondarily (not as important for now,) in the section where the HTML Text Doc is pulled up and information pulled up between start string and end string, can any one provide a code snippet that allows for me to copy the result and past it on "X Document" instead of the message box.

As always thanks for the incredible help.

Sub whitepages()


Dim objIEWP

'************Quotation
Dim myCell As Range
'************

Set objIEWP = CreateObject("InternetExplorer.Application")
objIEWP.Visible = False

'************************Application Activate
Set Wshshell = CreateObject("WScript.Shell")
'******************************************

'***************Pull All Websites Initially*************
objIEWP.navigate2 "[URL unfurl="true"]http://www.whitepages.com/reverse-lookup"[/URL]
objIEWP.Visible = True

'************************************************


'Whitepages.com
objIEWP.navigate2 "[URL unfurl="true"]http://www.whitepages.com/reverse-lookup"[/URL]
objIEWP.Visible = True
Application.Wait (Now + TimeValue("0:00:1"))
While objIEWP.busy
Wend
Wshshell.AppActivate "Free Reverse Lookup | WhitePages"
Application.Wait (Now + TimeValue("0:00:3"))
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"
Wshshell.SendKeys "{TAB}"

Application.Wait (Now + TimeValue("0:00:1"))
Address = Range("I11").Text
Wshshell.SendKeys Address
Wshshell.SendKeys "{TAB}"
Application.Wait (Now + TimeValue("0:00:1"))
Zip = Range("I14").Text
Wshshell.SendKeys Zip
Wshshell.SendKeys "{ENTER}"
Application.Wait (Now + TimeValue("0:00:3"))
Wshshell.AppActivate "Free Reverse Lookup | WhitePages"
Wshshell.SendKeys "%(VC)"

'**************
Dim lonPos As Long, lonEnd As Long
Dim strStart As String, strEnd As String
Dim strPhone As String

'The start string.
strStart = "<p class='single_result_phone landline'>"

'Find the start string.
lonPos = InStr(1, HTML, strStart, vbTextCompare)



'The start string.
strStart = "<p class='single_result_phone landline'>"
strEnd = "</p>"

'Find the start string.
lonPos = InStr(1, HTML, strStart, vbTextCompare)

If lonPos > 0 Then
    'Move to the end of the start string
    'which happens to be the beginning of what we're looking for. :)
    lonPos = lonPos + Len(strStart)
    
    'Find the end string starting from where we found the start.
    lonEnd = InStr(lonPos, HTML, strEnd, vbTextCompare)
    
    If lonEnd > 0 Then
        'Now, we have the starting and ending position.
        'What we do is extract the information between them.
        
        'The length of data (e-mail address) will be:
        'lonEnd - lonPos
        strPhone = Mid$(HTML, lonPos, lonEnd - lonPos)
        
        'Done!
        MsgBox strPhone
    End If
End If
End Sub