Question

我从网站上收集了这个vba代码。它应该从网页获取数据。但有时候，如果我为相应的内容和内容写入值，有时则不会。没有任何错误或任何错误。有人请帮我解决这个问题。我在下面给出了我的代码：

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

此代码用于对齐列：

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

Answer 1

你走了。

示例
工作类型：会计师
邮编：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代码从网页获取数据，但有时它可以工作，有时它无法获取

1 个答案: