www.upcdatabase.com

[bob5731]

Hi
Need to save all the date in ms access 2003 forum www.upcdatabase.com
code in vba

[Hack]

VBA question moved to Office Development.

[trisuglow]

Bob,

Thanks for your question. I'm not yet an HTML expert, but looking at this problem has got me started

This replacement code appears to work perfectly in debug mode if you single step through it. Running at full speed however suffers from some timing problems.

Anyway, your problem seems to stem from the fact that SendKeys wasn't working and its difficult to identify the button on the form because it hasn't been given a name. This code gets round the problem though.

Private Sub Command1_Click()
    Dim hBut As HTMLInputButtonElement
    Dim iStart As Integer
    Dim iEnd As Integer
    iStart = 0
    iEnd = 0
    If WebBrowser1.LocationURL <> "http://www.upcdatabase.com/nocheckdigit.pl" Then
        WebBrowser1.Navigate2 "http://www.upcdatabase.com/nocheckdigit.pl"
    End If
    Do While WebBrowser1.Busy = True
        DoEvents
        Sleep 500
    Loop
    Set hDoc = WebBrowser1.Document
    Set hInp = hDoc.getElementById("upc")
    hInp.focus
    hInp.Value = "07800008846"
    
    For Each hBut In hDoc.getElementsByTagName("INPUT")
      If hBut.Name = "" Then Exit For
    Next
    
    hBut.Click
        
    Do While WebBrowser1.Busy = True
        DoEvents
        Sleep 500
    Loop
    
    Set hInp = Nothing
    'Parse the elements and read the values of the data returned
    'Set document variable = to the new results documents page
    Set hDoc = WebBrowser1.Document
    'Find the description:
    iStart = InStr(1, hDoc.body.innerHTML, "<TD>Description</TD>") + 37
    iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
    MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    'Find the Size/Weight:
    iStart = InStr(iStart, hDoc.body.innerHTML, "<TD>Size/Weight</TD>") + 37
    iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
    MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    'Find Manufacturer:
    iStart = InStr(iStart, hDoc.body.innerHTML, "<TD>Manufacturer</TD>") + 38
    iEnd = InStr(iStart, hDoc.body.innerHTML, "(<A href=")
    MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    'Find the Entered/Modified:
    iStart = InStr(iStart, hDoc.body.innerHTML, "<TD>Entered/Modified</TD>") + 42
    iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
    MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
End Sub

[bob5731]

Hi
Tha code in vb 6.0 but I need in vbs.
Can You all help me get it into vba?

[trisuglow]

Sorry, looks like I misunderstood the question.

Haven't got the time now to help convert it to VBA. PM me next week if you don't get help from anybody else.

[bob5731]

can you help get start for now?

[Hack]

What part of what trisuglow posted won't work in VBA?

Have you tried it in VBA?

[Webtest]

He probably needs the Library Reference for starters!

Hey! I found it! Microsoft HTML Object Library

He'll also need:

Private Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

Public Sub Workbook_Open()
    Sleep 5000   'Implements a 5 second delay
End Sub

If he is using Option Explicit he'll need a Dim for "WebBrowser1"

[bob5731]

Option Explicit
'Add component to Microsoft HTML Object Library
'Add component Microsoft Internet Controls
 
'Add a command button (Command1)
'Add a web browser control to the form (wbbWebsite)
Dim hDoc 'As MSHTML.HTMLDocument
Dim hCol 'As MSHTML.IHTMLElementCollection
Dim hInp 'As MSHTML.HTMLInputElement
Dim hSub 'As MSHTML.HTMLInputButtonElement
Dim hTxt 'As MSHTML.HTMLInputTextElement
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
    'Application.Screen.MousePointer = 11 ' Hourglass
    'wbbWebsite.Navigate URL:="http://www.upcdatabase.com/nocheckdigit.pl"
    'MsgBox "**** You"
    'Application.Screen.MousePointer = 0 ' Back to normal
    wbbWebsite.Navigate URL:="http://www.upcdatabase.com/item.pl?upc"
    MsgBox "Hello"
End Sub
Private Sub Command1_Click()
wbbWebsite.Navigate URL:="http://www.upcdatabase.com/item.pl?upc"
MsgBox "Hello"
Set hDoc = wbbWebsite.Document
    Set hInp = hDoc.getElementById("upc")
    'hInp.focus
    'upc = "064144043248"
    hInp.Value = upc
    Set hInp = Nothing
    'Parse the elements and read the values of the data returned
    'Set document variable = to the new results documents page
    Set hDoc = wbbWebsite.Document
    'Find the description:
    'iStart = InStr(1, hDoc.body.innerHTML, "<TD>Description</TD>") + 37
    'iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
    'MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
End Sub
Private Sub Command2_Click()
On Error GoTo Err_Command2_Click
    Dim stDocName As String
    stDocName = "food"
    DoCmd.OpenDataAccessPage stDocName, acDataAccessPageBrowse
Exit_Command2_Click:
    Exit Sub
Err_Command2_Click:
    MsgBox Err.Description
    Resume Exit_Command2_Click
End Sub
Private Sub upc_Change()
    wbbWebsite.Navigate URL:="http://www.upcdatabase.com/item.pl?upc"
    MsgBox "Hello"
    Set hDoc = wbbWebsite.Document
    Set hInp = hDoc.getElementById("upc")
    hInp.Value = upc
    Set hInp = Nothing
End Sub

[Webtest]

Is there a References Library Function that can be used if you just use code and don't use a WebBrowser Control?

wbbWebsite.Navigate
wbbWebsite.Document

[bob5731]

I do not know.