VBA code is unable to download and save file using link

[vrsharma]

Hello Team,

I am unable to download and save file from website using VBA code. I have tried various methods for this still I am unable to download the file. If file is downloaded from another method its get corrupted. This problem exist only on this website this code works fine for another website. I am currently using Excel 2016.
Please find below vba code. Please help me on this and let me know what i am doing wrong.

---------------------------------------------------------------------------------------------------------------------------------------------------
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\StepFile.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

 

[Legacy 98055]

Here is an example for one of your files. Adapt it to suit.

Private Declare PtrSafe Function URLDownloadToFile _
    Lib "urlmon" _
    Alias "URLDownloadToFileA" ( _
    ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long _
    ) As Long


Sub TestNet2Local()
    Dim myUrl As String
    Dim myFileFullName As String
    
    myUrl = "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"
    myFileFullName = "C:\MyDownloads\StepFile.zip"
    Net2Local myUrl, myFileFullName
    
End Sub


Function Net2Local(url As String, fileFullName As String)
    URLDownloadToFile 0, url, fileFullName, 0, 0
End Function

 

[vrsharma]

Thanks for your code Tom,
It is downloading the file but when I try to open, it is getting corrupted.
Could you please help me on this and give advice why the file is getting corrupted after download.

 

[Legacy 98055]

I did not have a problem with the files. I have no idea why they are getting corrupted on your machine. Anyone else?

 

[Legacy 98055]

Sub TestNet2Local()
    Dim myUrl As String
    Dim myFileFullName As String
    
    myUrl = "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"
    myFileFullName = "C:\MyDownloads\StepFile.zip"
    Net2Local myUrl, myFileFullName
    
    myUrl = "https://www.te.com/commerce/DocumentDelivery/DDEController?Action=showdoc&DocId=Customer+Drawing%7F212522%7FW%7Fpdf%7FEnglish%7FENG_CD_212522_W.pdf%7F5-212522-1"
    myFileFullName = "C:\MyDownloads\StepFile.pdf"
    Net2Local myUrl, myFileFullName
End Sub

 

[vrsharma]

I am also not getting why this problem is only with me, since this same code works fine for other websites.
Anyone who can help me in this?