如何编写VBA脚本以从网站获取数据?

时间:2018-02-11 23:48:49

标签: excel-vba web-scraping vba excel

我是这个编程领域的新手,目前正在学习excel VBA脚本。我遇到了代码问题,我试图从this website中提取某些数据。我的主要想法是,如果我输入产品编号和数量详细信息,特定的产品详细信息应存储在我的Excel工作表中。

如果我选择螺丝并在搜索栏中输入产品编号或螺丝名称,则应自动下载该螺丝的技术数据。

到目前为止,我已收集了一些信息并编写了此代码,但它无效。

Sub test()


Dim eRow As Long
Dim elemCollection As Object
Dim IE As Object, obj As Object
Dim r As Long, c As Long, t As Long
Set MyObject = Sheets(1)


Set sht = Sheets("Sheet1")
RowCount = 1
sht.Range("A" & RowCount) = "Thread Size"
sht.Range("B" & RowCount) = "Length"
sht.Range("C" & RowCount) = "Threading"
sht.Range("D" & RowCount) = "Profile"
sht.Range("E" & RowCount) = "Head Diameter"
sht.Range("F" & RowCount) = "Head Height"
sht.Range("G" & RowCount) = "Countersink Angle"
sht.Range("H" & RowCount) = "Drive Style"
sht.Range("I" & RowCount) = "Drive Size"
sht.Range("J" & RowCount) = "Material"
sht.Range("K" & RowCount) = "Thread Type"
sht.Range("L" & RowCount) = "Thread Spacing"
sht.Range("M" & RowCount) = "Thread Fit"
sht.Range("N" & RowCount) = "Head Type"
sht.Range("O" & RowCount) = "System of Measurement"
sht.Range("P" & RowCount) = "Specifications Met"
sht.Range("Q" & RowCount) = "UnitCost"
sht.Range("R" & RowCount) = "QTY"


Set objIE = CreateObject("InternetExplorer.Application")

mypart = InputBox("Please enter the product number")
myQTY = InputBox("No. of Quantity Ordered")

With objIE
.Visible = True
.navigate "https://www.mcmaster.com/#screws/=1bj14dv"

Do While .Busy Or _
.readyState <> 4
    DoEvents
Loop

Set searchbar = .documents.getElementsByName("srchEntryWebpart_Inpbox")
searchbar.Item(0).Value = mypart

Set qtyinput = .documents.getElementsByName("input-simple--qty")
qtyinput.Item(0).Value = QTY

Set elemCollection = IE.document.getElementsByTagName("Spec-table--pd").Value
IE.document.getElementsByTagName("searchbar-button").submit

For Each ele In .document.all
Select Case ele.className
Case "srchEntryWebpart_Inpbox"
RowCount = RowCount + 1
Case "divider--spec-tbl value-cell--table"
sht.Range("A" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("B" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("C" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("D" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("E" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("F" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("G" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("H" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("I" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("J" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("K" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("L" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("M" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("N" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("O" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("P" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("Q" & RowCount) = ele.innerText
Case "divider--spec-tbl value-cell--table"
sht.Range("R" & RowCount) = ele.innerText

End Select
Next ele


'For t = 0 To (elemCollection.Length - 1)
    'For r = 0 To (elemCollection(t).Rows.Cells.Length - 1)
        'For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
        'eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        'ThisWorkbook.Worksheets(1).Cells(eRow, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
        'Next c
    'Next r
'Next t


End With
Range("A1:R1000").Columns.AutoFit


Set IE = Nothing

'
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\VamsiK\Documents\Mcmaster inventory 1.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Save
    ActiveWorkbook.Save
    ActiveWorkbook.Save
    ActiveWorkbook.Save
    ActiveWorkbook.Save
End Sub

0 个答案:

没有答案