Question

我无法使用VBA代码从网站下载和保存文件。我已经尝试过各种方法，但是仍然无法下载文件。如果文件是从另一种方法下载的，则它已损坏。此问题仅存在于此网站上，此代码可用于其他网站。我当前正在使用Excel 2016。请在下面找到vba代码。请帮助我，让我知道我做错了。

Option Explicit

Sub teScrapping()

    Const TITLES As String = "Features"

    Dim IE As SHDocVw.InternetExplorer
    Set IE = New InternetExplorer
    Dim TitlesCount As Long, NoChangesCount As Long
    Dim fileLink As MSHTML.IHTMLElementCollection
    Dim searchBoxValue As String
    Dim html As HTMLDocument
    Dim WinHttpReq As Object
    Dim oStream As Object
    Dim cnt As Integer
    Dim DownloadStatus As Long
    Dim LinkStpFile As String
    Dim LinkDrawingFile As String


    searchBoxValue = "5-212522-1"

    'On Error Resume Next

    IE.Visible = True

    IE.navigate "https://www.te.com/usa-en/home.html"

    While IE.readyState <> 4 Or IE.Busy
        DoEvents
    Wend

    Dim idoc As MSHTML.HTMLDocument
    Set idoc = IE.document

    idoc.getElementById("search-input").Value = searchBoxValue

    Dim doc_ele As MSHTML.IHTMLElement
    Dim doc_eles As MSHTML.IHTMLElementCollection
    Set doc_eles = idoc.getElementsByTagName("INPUT")

    For Each doc_ele In doc_eles
        If doc_ele.getAttribute("value") = "Search by part # or keyword" Then
            doc_ele.Click
            Exit For
        Else
        End If
    Next doc_ele

    ' Waiting page to load competely
    Set html = IE.document
    On Error Resume Next
    Do
        DoEvents
        Application.Wait Now() + TimeValue("00:00:02")
        TitlesCount = GetClassCount(html, TITLES)
        html.parentWindow.scrollBy 0, 99999
        If TitlesCount = GetClassCount(html, TITLES) Then
            NoChangesCount = NoChangesCount + 1
        Else
            NoChangesCount = 0
        End If
    Loop Until NoChangesCount = 5 ' If no changes for some attempts, assume end of dynamic page
    On Error GoTo 0

    LinkStpFile = "https://www.te.com/commerce/DocumentDelivery/DDEController?Action=showdoc&DocId=Customer+View+Model%7FCVM_5-212522-1%7FAE%7F3d_stp.zip%7FEnglish%7FENG_CVM_CVM_5-212522-1_AE.3d_stp.zip%7F5-212522-1"

    'Downloading stp fille
    Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    WinHttpReq.Open "POST", LinkStpFile, False, "username", "password"
    WinHttpReq.send

    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile "C:\MyDownloads\StepFile.zip", 2 ' 1 = no overwrite, 2 = overwrite
        oStream.Close
    End If


    'Download Drawing File
    LinkDrawingFile = "https://www.te.com/commerce/DocumentDelivery/DDEController?Action=showdoc&DocId=Customer+Drawing%7F212522%7FW%7Fpdf%7FEnglish%7FENG_CD_212522_W.pdf%7F5-212522-1"

    Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    WinHttpReq.Open "POST", LinkDrawingFile, False, "username", "password"
    WinHttpReq.send

    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile "C:\MyDownloads\DrawFile.pdf", 2 ' 1 = no overwrite, 2 = overwrite
        oStream.Close
    End If


  Set IE = Nothing

End Sub

Private Function GetClassCount(Doc As HTMLDocument, ClassName As String) As Long
    GetClassCount = Doc.getElementsByClassName(ClassName).Length
End Function

VBA代码无法从网站下载和保存文件

0 个答案: