尝试使用VBA代码从网页获取数据，但有时它可以工作，有时它不会获取 [英] Trying to fetch data from webpage with a VBA code, but sometimes it works and sometimes it does not fetch

问题描述

我从网站收集了这个vba代码。它应该从网页中获取数据。但是有时如果我为它读取数据的时间和地点写下值，有时它不会。没有任何错误或任何东西。任何人请帮我解决问题。我在下面给出我的代码：

  Sub test（）
 Dim eRow As Long 
 Dim ele As对象
设置sht =表（Sheet1）
 RowCount = 1 
 sht.Range（A& RowCount）=标题
 sht.Range（B & RowCount=Company
 sht.Range（C& RowCount）=位置
 sht.Range（D& RowCount）=描述
 
 eRow = Sheet1.Cells（Rows.Count，1）.End（xlUp）.Offset（1，0）.Row 
 
设置objIE = CreateObject（InternetExplorer.Application） 
 
 myjobtype = InputBox（输入工作类型，例如销售，管理）
 myzip = InputBox（输入您希望工作的区域的邮政编码）
 
 With objIE 
 .Visible = True 
 .navigatehttp://www.jobs.com/
 Do While .Busy或_ 
 .readyState<> 4 
 DoEvents 
循环
设置what = .document.getElementsByName（q）
 what.Item（0）.Value = myjobtype 
设置zipcode = .document .getElementsByName（where）
 zipcode.Item（0）.Value = myzip 
 .document.getElementById（JobsButton）。单击
 Do While .Busy或_ 
 .readyState<> 4 
 DoEvents 
循环
对于每个ele在.document.all 
中选择案例ele.classname 
案例结果
 RowCount = RowCount + 1 
案例标题
 sht.Range（A& RowCount）= ele.innertext 
案例公司
 sht.Range（B& RowCount）= ele.innertext 
案例位置
 sht.Range（C& RowCount）= ele.innertext 
案例描述
 sht.Range（D& ; RowCount）= ele.innertext 
结束选择
下一步
结束
宏1 
设置objIE =没有
结束Sub 
  

此代码用于对齐列：

  Sub Macro1（）
'
'Macro1宏
'格式化导入的数据
'
'
列（A：D ）。选择
 Selection.Columns.AutoFit 
带有选择
 .VerticalAlignment = xlTop 
 .Orientation = 0 
 .AddIndent = False 
 .IndentLevel = 0 
 .ShrinkToFit = False 
 .ReadingOrder = xlContext 
结束
范围（D1）。选择
 Colum ns（D：D）ColumnWidth = 50 
列（A：D）选择
 Selection.Rows.AutoFit 
 End Sub 
  




解决方案

你走了。

strong>示例

工作类型：会计师
邮政编码：94551

  Sub GetData（）
 
 Dim eRow As Long 
 Dim html As Object，ele As Object，xmlHttp As Object 
 Dim URL As String，myjobtype As String， myzip As String 
 
 Set sht = Sheets（Sheet1）
 RowCount = 1 
 sht.Range（A& RowCount）=Title
 sht.Range（B& RowCount）=Company
 sht.Range（C& RowCount）=Location
 sht。范围（D& RowCount）=描述
 
 eRow = Sheet1.Cells（Rows.Count，1）.End（xlUp）.Offset（1，0）.Row 
 
 myjobtype = InputBox（输入工作类型例如销售，管理）
 myzip = InputBox（输入您希望工作的区域的邮政编码）
 
 
设置xmlHttp = CreateObject（MSXML2.XMLHTTP）
 
 URL =http://jobs.com/search?where=& myzip& & q =& myjob型& & rnd =& WorksheetFunction.RandBetween（1，1000）
 
 xmlHttp.OpenGET，URL，False 
 xmlHttp.setRequestHeaderContent-Type，text / xml
 xmlHttp。发送
 
 
 
设置html = CreateObject（htmlfile）
 html.body.innerHTML = xmlHttp.ResponseText 
 
对于每个ele在html.all 
选择案例ele.classname 
案例结果
 RowCount = RowCount + 1 
案例标题
 sht.Range（A& ; RowCount）= ele.innertext 
案例公司
 sht.Range（B& RowCount）= ele.innertext 
案例位置
 sht.Range C& RowCount）= ele.innertext 
案例描述
 sht.Range（D& RowCount）= ele.innertext 
结束选择
下一个ele 
 
宏1 
 End Sub 
 
 Sub Macro1（）
'
'Macro1宏
'格式化导入的数据
'
'
列（A ：D）。选择
 Selection.Columns.AutoFit 
带有选择
 .VerticalAlignment = xlTop 
 .Orientation = 0 
 .AddIndent = False 
。 IndentLevel = 0 
 .ShrinkToFit = False 
 .ReadingOrder = xlContext 
结束
范围（D1）。选择
列（D：D）。 ColumnWidth = 50 
列（A：D）。选择
 Selection.Rows.AutoFit 
 End Sub 
  

I have collected this vba code from a websites. it should fetch data from a webpage. But sometimes if I write value for what and where it fetches data accordingly, sometimes it does not. there is no error or anything. Anyone please help me about the problem. I am giving my code below:

Sub test()
Dim eRow As Long
Dim ele As Object
Set sht = Sheets("Sheet1")
RowCount = 1
sht.Range("A" & RowCount) = "Title"
sht.Range("B" & RowCount) = "Company"
sht.Range("C" & RowCount) = "Location"
sht.Range("D" & RowCount) = "Description"

eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Set objIE = CreateObject("InternetExplorer.Application")

myjobtype = InputBox("Enter type of job eg. sales, administration")
myzip = InputBox("Enter zipcode of area where you wish to work")

With objIE
.Visible = True
.navigate "http://www.jobs.com/"
Do While .Busy Or _
.readyState <> 4
DoEvents
Loop
Set what = .document.getElementsByName("q")
what.Item(0).Value = myjobtype
Set zipcode = .document.getElementsByName("where")
zipcode.Item(0).Value = myzip
.document.getElementById("JobsButton").Click
Do While .Busy Or _
.readyState <> 4
DoEvents
Loop
For Each ele In .document.all
Select Case ele.classname
Case "Result"
RowCount = RowCount + 1
Case "Title"
sht.Range("A" & RowCount) = ele.innertext
Case "Company"
sht.Range("B" & RowCount) = ele.innertext
Case "Location"
sht.Range("C" & RowCount) = ele.innertext
Case "Description"
sht.Range("D" & RowCount) = ele.innertext
End Select
Next ele
End With
Macro1
Set objIE = Nothing
End Sub

This code is for aligning the columns:

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

解决方案

Here you go.

Example
Type of Job : Accountant
zipcode :94551

Sub GetData()

    Dim eRow As Long
    Dim html As Object, ele As Object, xmlHttp As Object
    Dim URL As String, myjobtype As String, myzip As String

    Set sht = Sheets("Sheet1")
    RowCount = 1
    sht.Range("A" & RowCount) = "Title"
    sht.Range("B" & RowCount) = "Company"
    sht.Range("C" & RowCount) = "Location"
    sht.Range("D" & RowCount) = "Description"

    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    myjobtype = InputBox("Enter type of job eg. sales, administration")
    myzip = InputBox("Enter zipcode of area where you wish to work")


    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")

    URL = "http://jobs.com/search?where=" & myzip & "&q=" & myjobtype & "&rnd=" & WorksheetFunction.RandBetween(1, 1000)

    xmlHttp.Open "GET", URL, False
    xmlHttp.setRequestHeader "Content-Type", "text/xml"
    xmlHttp.send



    Set html = CreateObject("htmlfile")
    html.body.innerHTML = xmlHttp.ResponseText

    For Each ele In html.all
        Select Case ele.classname
        Case "Result"
            RowCount = RowCount + 1
        Case "Title"
            sht.Range("A" & RowCount) = ele.innertext
        Case "Company"
            sht.Range("B" & RowCount) = ele.innertext
        Case "Location"
            sht.Range("C" & RowCount) = ele.innertext
        Case "Description"
            sht.Range("D" & RowCount) = ele.innertext
        End Select
    Next ele

    Macro1
End Sub

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

这篇关于尝试使用VBA代码从网页获取数据，但有时它可以工作，有时它不会获取的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！