Need Help To Pull Data From Web Site Using Macro

[babulalgandhi]

Hi friends I am new to macro.

I am trying to pull data from webpage like name, contact no. And address in excel. if I put webpage links in Column A1,A2,A3... And So On. The output data Will Avalable in B1 as Company Name, C1 as Address, D1 as Contact Mobile1, E1 as Contact Mobile2, F1 as Contact Mobile3, G1 as Contact Mobile4, H1 as Contact Telephone1, I1 as Contact Telephone1, J1 as Contact Telephone1, K1 as Contact Telephone1, and L1 as Website.

Thanks in advance for your help.

I Am Trying From 5 Day's And I Learn Watching Youtube Video Of Dinesh Kumar Takyar And
Learned From These Friends Posts In Other Members Thread's

Excel Help Forum
User Kyle - Stack Overflow
http://www.mrexcel.com/forum/members/ukmikeb.html
User dee - Stack Overflow
Free Excel\VBA Help Forum
User omegastripes - Stack Overflow
http://www.mrexcel.com/forum/members/john_w.html

Thanks You All For UR Posts My Teachers



Sub Macro1()
'
' Macro1 Macro
' Formatting imported data
'
'
Columns("A:F").Select
Selection.Columns.AutoFit
With Selection
.VerticalAlignment = xlTop
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("F1").Select
Columns("F:F").ColumnWidth = 50
Columns("A:F").Select
Selection.Rows.AutoFit
End Sub




Sub test()

Dim eRow As Long
Dim ele As Object
Set sht = Sheets("Sheet1")
RowCount = 1
sht.Range("A" & RowCount) = "Company"
sht.Range("B" & RowCount) = "Location"
sht.Range("C" & RowCount) = "Mobile"
sht.Range("D" & RowCount) = "Telephone"
sht.Range("E" & RowCount) = "Website"
sht.Range("F" & RowCount) = "Fax"
eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.Visible = False
.Navigate "http://www.justdial.com/Mumbai/Tiles-Styles-India-Pvt-Ltd-%3Cnear%3E-Behind-Glaxo-Worli-Colony-Worli-New/022PXX22-XX22-120319115535-K7W9_TXVtYmFpIFRpbGUgRGVhbGVycyBXaXRoIEVtYWlsIEFkZHJlc3M=_BZDET"
Do Until .ReadyState = 4: DoEvents: Loop
For Each ele In .document.all
Select Case ele.classname
Case "Result"
RowCount = RowCount + 1
Case "ghd"
sht.Range("A" & RowCount+1) = ele.innertext
Case "jaddt"
sht.Range("B" & RowCount+1) = ele.innertext
Case "jmob"
sht.Range("C" & RowCount+1) = ele.innertext
Case "jtel"
sht.Range("D" & RowCount+1) = ele.innertext
Case "wsurl"
sht.Range("E" & RowCount+1) = ele.innertext
Case "jfax"
sht.Range("F" & RowCount+1) = ele.innertext
End Select
Next ele
End With
Macro1
Set objIE = Nothing
End Sub

 

[John_w]

Try this:

Option Explicit

Sub test()

    Dim ele As Object
    Dim sht As Worksheet
    Dim RowCount As Long
    Dim objIE As Object
    
    Set sht = Sheets("Sheet1")
    sht.Range("A1").Value = "Company"
    sht.Range("B1").Value = "Location"
    sht.Range("C1").Value = "Mobile"
    sht.Range("D1").Value = "Telephone"
    sht.Range("E1").Value = "Website"
    sht.Range("F1").Value = "Fax"
    RowCount = sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row - 1
    
    Set objIE = CreateObject("InternetExplorer.Application")
    With objIE
        .Visible = True
        .navigate "http://www.justdial.com/Mumbai/Tiles-Styles-India-Pvt-Ltd-%3Cnear%3E-Behind-Glaxo-Worli-Colony-Worli-New/022PXX22-XX22-120319115535-K7W9_TXVtYmFpIFRpbGUgRGVhbGVycyBXaXRoIEVtYWlsIEFkZHJlc3M=_BZDET"
        Do Until .readyState = 4: DoEvents: Loop
        
        For Each ele In .document.all
            Select Case ele.className
                Case "fn"
                    RowCount = RowCount + 1
                    sht.Cells(RowCount, "A").Value = ele.innerText
                Case "jaddt"
                    sht.Cells(RowCount, "B").Value = ele.FirstChild.NodeValue
                Case "jtel"
                    sht.Cells(RowCount, "C").Value = ele.NextSibling.innerText
                Case "jmob"
                    sht.Cells(RowCount, "D").Value = ele.NextSibling.innerText
                Case "wsurl"
                    sht.Cells(RowCount, "E").Value = ele.innerText
                Case "jfax"
                    sht.Cells(RowCount, "F").Value = ele.parentElement.innerText
            End Select
        Next
        
    End With
    
    Set objIE = Nothing
    
End Sub

You'll find it easier if you reference the HTML object library and declare variables of the appropriate HTML class. Also, use Option Explicit at the top of the module and make sure your code compiles without error (Debug -> Compile menu option).

 

[babulalgandhi]

Try this:

Option Explicit

Sub test()

    Dim ele As Object
    Dim sht As Worksheet
    Dim RowCount As Long
    Dim objIE As Object
    
    Set sht = Sheets("Sheet1")
    sht.Range("A1").Value = "Company"
    sht.Range("B1").Value = "Location"
    sht.Range("C1").Value = "Mobile"
    sht.Range("D1").Value = "Telephone"
    sht.Range("E1").Value = "Website"
    sht.Range("F1").Value = "Fax"
    RowCount = sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row - 1
    
    Set objIE = CreateObject("InternetExplorer.Application")
    With objIE
        .Visible = True
        .navigate "http://www.justdial.com/Mumbai/Tiles-Styles-India-Pvt-Ltd-%3Cnear%3E-Behind-Glaxo-Worli-Colony-Worli-New/022PXX22-XX22-120319115535-K7W9_TXVtYmFpIFRpbGUgRGVhbGVycyBXaXRoIEVtYWlsIEFkZHJlc3M=_BZDET"
        Do Until .readyState = 4: DoEvents: Loop
        
        For Each ele In .document.all
            Select Case ele.className
                Case "fn"
                    RowCount = RowCount + 1
                    sht.Cells(RowCount, "A").Value = ele.innerText
                Case "jaddt"
                    sht.Cells(RowCount, "B").Value = ele.FirstChild.NodeValue
                Case "jtel"
                    sht.Cells(RowCount, "C").Value = ele.NextSibling.innerText
                Case "jmob"
                    sht.Cells(RowCount, "D").Value = ele.NextSibling.innerText
                Case "wsurl"
                    sht.Cells(RowCount, "E").Value = ele.innerText
                Case "jfax"
                    sht.Cells(RowCount, "F").Value = ele.parentElement.innerText
            End Select
        Next
        
    End With
    
    Set objIE = Nothing
    
End Sub

You'll find it easier if you reference the HTML object library and declare variables of the appropriate HTML class. Also, use Option Explicit at the top of the module and make sure your code compiles without error (Debug -> Compile menu option).

I Have Marked Microsoft HTML Object Library & Microsoft Internet Controls

I Tried To Run Macro
Run-time error '438' Object doesn't support this property or method

On The Line
sht.Cells(RowCount, "C").Value = ele.NextSibling.innerText

I Have Searched For Run-time error '438' Link Url Excel VBA: Run-time error '438' Object doesn't support this property or method - Stack Overflow

I Didn't Figure Out How To Solve.

I Am Trying For Macro Loop To Read Web Pages Urls From Sheet 1 (Raw 1) And Give Web Data Output In Sheet 2 (Raw 1) And Like Wise
Urls From Sheet 1 (Raw 2) And Give Web Data Output In Sheet 2 (Raw 2)

Also Trying To Solve Class Name (Jtel) & (Jmob). I Can't Get Data From Contact Who Has Two Or More Telephone Numbers & Two Or More Mobile Numbers In Web Page To Excel.

May Your Explanation Will Guide Me

Thanks For Your Reply John

 

[ukmikeb]

Hi

Looking at the website IMO it does not appear that the Telephone Number and Mobile Number classes have been set up with "child classes".

This change to your coding :-

Option Explicit
Sub Test()
   Dim ele As Object
    Dim sht As Worksheet
    Dim RowCount As Long
    Dim objIE As Object
    Dim jm, jt
    Dim jmsw, jtsw
    
    Set sht = Sheets("Sheet1")
    sht.Range("A1").Value = "Company"
    sht.Range("B1").Value = "Location"
    sht.Range("C1").Value = "Mobile"
    sht.Range("D1").Value = "Telephone"
    sht.Range("E1").Value = "Website"
    sht.Range("F1").Value = "Fax"
    RowCount = sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row - 1
    
    jm = 0: jt = 0
    
    Set objIE = CreateObject("InternetExplorer.Application")
    With objIE
        .Visible = True
        .Navigate "http://www.justdial.com/Mumbai/Tiles-Styles-India-Pvt-Ltd-%3Cnear%3E-Behind-Glaxo-Worli-Colony-Worli-New/022PXX22-XX22-120319115535-K7W9_TXVtYmFpIFRpbGUgRGVhbGVycyBXaXRoIEVtYWlsIEFkZHJlc3M=_BZDET"
        Do Until .ReadyState = 4: DoEvents: Loop
        
        For Each ele In .Document.all
               ChkStr = ele.classname
               Select Case ele.classname
                Case "fn"
                    RowCount = RowCount + 1
                    sht.Cells(RowCount, "A").Value = ele.innertext
                Case "jaddt"
                    sht.Cells(RowCount, "B").Value = ele.FirstChild.NodeValue
                Case "jtel"
                    jt = 1: jtsw = 0: jm = 0
                Case "jmob"
                     jm = 1: jmsw = 0: jt = 0
                Case "wsurl"
                    sht.Cells(RowCount, "E").Value = ele.innertext
                Case "jfax"
                    sht.Cells(RowCount, "F").Value = ele.parentElement.innertext
                Case "tel"
                    If jm Then
                        jmsw = jmsw + 1
                        If jmsw = 1 Then
                            sht.Cells(RowCount, "D").Value = ele.innertext
                        Else
                            ' jmsw > 1
                            sht.Cells(RowCount, "D").Value = sht.Cells(RowCount, "D").Value & ", " & Chr(10) & ele.innertext
                        End If
                    End If
                    If jt Then
                        jtsw = jtsw + 1
                        If jtsw = 1 Then
                            sht.Cells(RowCount, "C").Value = ele.innertext
                        Else
                            ' jtsw > 1
                            sht.Cells(RowCount, "C").Value = sht.Cells(RowCount, "C").Value & ", " & Chr(10) & ele.innertext
                        End If
                    End If
            End Select
        Next
        
    End With
    
    Set objIE = Nothing
'
End Sub

should cope with multiple numbers.

There is a class of "tel" within each of the "jmob" and "jtel" classes and having been triggered by the relevant class the module will act on the "tel" class as belonging the last read "jmob" or "jtel" class. If ever a situation occurs that there are multiple fax numbers you could make a similar change to the coding to handle those.

Btw your headings for Mobile and Telephone are the wrong way round.

hth