Excel 2010 to 2016 broke VB code?

[Rick-O-Shay]

I have a spreadsheet which works fine and was created in Excel 2010. We will be upgrading to Excel 2016 soon, but for some strange reason my script will not work on newer versions of Excel. I don't even know where to begin trouble shooting this, as it seems to me it should work fine across all versions. My code is below. I also attached my file.

Sub Test()
    ActiveSheet.Unprotect Password:=""
    
       
    
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://www.wsj.com/market-data/bonds", Destination:=Range("$B$2"))
        .Name = "myQuery"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        
        .RefreshPeriod = 0
        
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "1"
        
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With


 Dim L&
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", "https://www.wsj.com/market-data/bonds", False
        .setRequestHeader "DNT", "1"
        .send
     If .Status = 200 Then
         L = InStr(.responseText, "Rates shown are effective")
         If L Then ActiveSheet.Range("A12") = Mid(.responseText, L, InStr(L, .responseText, "</") - L)
     End If
    End With


ActiveSheet.Protect Password:=""
End Sub

[Haluk]

Rick, in order to help you I've to buy Excel 2016 to see what the error message and at which line it occurs.

But, maybe you can tell us this info to make a suggestion to you.

.

[Rick-O-Shay]

Good idea. Here is the error:

Error Code: System Error &H80072F7D (-2147012739). An error occurred in the secure channel support.

[Haluk]

Well, on which line do you get this error ?

After the line "Dim L&" ?

.

[TMS]

Bad news. It works for me unedited/unchanged.

I have 64 bit Windows and 32 bit Office/Excel. It's a 365 subscription ... so, 2016 or whatever. Which versions(s) of Excel don't work for you? Are you missing any references in your VBA Project.

It may be that the newer versions are 64 bit and the code may be slightly different.

As Haluk has said, we would need to know where and how it fails for you.

[Rick-O-Shay]

Just had a chance to look at this again. I don't know how to know which line of code is the problem. I just tried the code again with two different users who have Excel 2016 and it throws the same error... We are going to upgrade soon and I need to have this work.

I open my code, click run script, and I see a different error: Run-time error '-2147012739 (80072f7d) Automation error

Any help would be appreciated, as the upgrade will break this workbook for many users...

[Rick-O-Shay]

I am using Microsoft Office Professional Plus 2016, which breaks the code, prior to that Excel 2010 worked fine. Makes no logical sense. Also, I double checked, both are the 32-bit versions.

If I remove this portion of the code, it works but I need that portion of the script to pull in the effective date of the rates:

Dim L&
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", "https://www.wsj.com/market-data/bonds", False
        .setRequestHeader "DNT", "1"
        .send
     If .Status = 200 Then
         L = InStr(.responseText, "Rates shown are effective")
         If L Then ActiveSheet.Range("A12") = Mid(.responseText, L, InStr(L, .responseText, "</") - L)
     End If
    End With

[Exceloof]

Just had a chance to look at this again. I don't know how to know which line of code is the problem. I just tried the code again with two different users who have Excel 2016 and it throws the same error... We are going to upgrade soon and I need to have this work.

I open my code, click run script, and I see a different error: Run-time error '-2147012739 (80072f7d) Automation error

Any help would be appreciated, as the upgrade will break this workbook for many users...

Use F8 to step into the code (go through it line-by-line) instead of just pressing run.

[Rick-O-Shay]

Ah, thanks!

It errors here: If. Status = 200 Then

[Rick-O-Shay]

From further research, I am wondering if we can use a readystate command here, but I just don't know enough yet to know what I am doing. I think this line is just checking to see if the website loaded, right? Would readystate be a good replacement? If so, how would I write that?

[MohsenAlyafei]

The problem could be caused by Microsoft Office not correctly handling the TLS 1.2 certificate installed on the server.
The fix to this problem is available in a Microsoft article 3140245.

[Rick-O-Shay]

Mohsen, if that is the issue, that is a problem because I can't be doing updates like this company wide to fix the issue... The fact that it worked in prior versions would indicate there would be some kind of work around...

[AliGW]

Which version of Windows are you running?

[Rick-O-Shay]

I get the error on Windows 7, I think some of the other users in the company have Windows 10 that are getting the error.

[MohsenAlyafei]

The codes on all sheets work fine under Windows 10 (using Excel 2019 under Office Professional Plus 2019). No errors generated.

[Rick-O-Shay]

Bizarre, I have had multiple different people show me that it will not work on Office 2016, including me on my home PC... It does not make any sense.

[Haluk]

Rick;

I've encountered with the same error. I am using Excel 2010 (32 Bit) on Win7-Home (64 bit).

I changed the 2nd part of the code and instead of using "WinHttp.WinHttpRequest" I used "MSXML2.XMLHTTP" object.

Here is the revised code that works fine for me;

Sub Test()
    'Haluk - 18/07/2019
    'sa4truss@gmail.com
    
    Dim xmlHTTPReq As Object
    Dim postURL As String
    Dim L As Long
    
    postURL = "https://www.wsj.com/market-data/bonds"
    
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & postURL, Destination:=Range("$B$2"))
        .Name = "myQuery"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        
        .RefreshPeriod = 0
        
        .WebSelectionType = xlSpecifiedTables
        .WebTables = 1
        
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    
    Set xmlHTTPReq = CreateObject("MSXML2.XMLHTTP")
    
    With xmlHTTPReq
        .Open "GET", postURL, False
        .send
    End With
    
    L = InStr(xmlHTTPReq.responseText, "Rates shown are effective")
    If L Then ActiveSheet.Range("A12") = Mid(xmlHTTPReq.responseText, L, InStr(L, xmlHTTPReq.responseText, "</") - L)
    
    Set xmlHTTPReq = Nothing
End Sub

.

[Rick-O-Shay]

Haluk, you are my hero dude. This worked!

[TMS]

I'm using an Office 365 subscription (32 bit). The code works both from the buttons on each sheet and stepping through using F8 (although I wouldn't have expected that to fail if the button worked).

I've tried running the code, clearing the table, and running it again. All with no issues.

If you comment out the If and End If lines of code, does it run through?

Do the other subroutines work ok?

[Haluk]

Rick;

Another alternative is; to use the XMLHTTP object also for the 1st part of the original code, which involves with a query to get data from a table.

By adding 2 references to the project via Tools >> References menu in VBA editor the following code will work faster, I hope...

Reference-1: Microsoft XML V6.0
Reference-2: Microsoft HTML Object Library

I also attached a workbook including the below alternative code.

Sub Test2()
    'Haluk - 18/07/2019
    'sa4truss@gmail.com
    'References added to the project:
    '1) Microsoft XML V6.0
    '2) Microsoft HTML Object Library
    
    Dim xmlHTTPReq As XMLHTTP
    Dim HTMLdoc As HTMLDocument
    Dim postURL As String
    Dim noRows As Integer, i As Integer, j As Integer
    
    Set xmlHTTPReq = New XMLHTTP
    Set HTMLdoc = New HTMLDocument
    
    postURL = "https://www.wsj.com/market-data/bonds"
    
    xmlHTTPReq.Open "GET", postURL, False
    xmlHTTPReq.send
   
    If xmlHTTPReq.Status = 200 Then
        HTMLdoc.body.innerHTML = xmlHTTPReq.responseText

        Set Tables = HTMLdoc.getElementsByTagName("Table")
        Set myTable = Tables(0)

        noRows = myTable.Rows.Length

        For i = 0 To noRows - 1
            For j = 0 To myTable.Rows(i).Cells.Length - 1
                Cells(i + 1, j + 1) = myTable.Rows(i).Cells(j).innerText
            Next
        Next
        Range("A12") = HTMLdoc.getElementsByClassName("WSJTheme--intro-text--2pqtJQIp ")(0).innerText
    End If

    Columns.AutoFit
    
    Set Tables = Nothing
    Set myTable = Nothing
    Set HTMLdoc = Nothing
    Set xmlHTTPReq = Nothing
End Sub