Как исправить VBA не может найти ошибку установленного isam

У меня есть строка подключения, которая загружает диапазон ячеек в мой список sharepoint. Сегодня кто-то не смог использовать эту функцию и получил ошибку при запуске макроса. Ошибка была Cannot Find Installable ISAM. Этот человек работает под управлением Office 2013, я использую Office 365 / Excel 2016. Не уверен, что это связано с тем, что строка подключения не установлена ​​для более старых версий Office. Я заблокировал название моей компании в моей строке. .Openподсвечивается за ошибку. Любая помощь будет оценена. Вот мой код:

Public Sub update_SP() Dim cnt As ADODB.Connection Dim rst As ADODB.Recordset Dim mySQL As String  Set cnt = New ADODB.Connection Set rst = New ADODB.Recordset  mySQL = "SELECT * FROM [opsmangement] WHERE [branch]= '" & Sheet18.Range("A10").Value & "'"  On Error GoTo errorhndlr  With cnt .ConnectionString = _ "Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;DATABASE=http://companyname.us.company-dns.com/sites/portvanregion/downtown/;LIST=;" .Open End With  rst.Open mySQL, cnt, adOpenDynamic, adLockOptimistic rst.Fields("branch") = Sheet18.Range("A10").Value 'rst.Fields("declined") = Sheet18.Range("A11").Value rst.Fields("cashbox exposures") = Sheet18.Range("A12").Value rst.Fields("exposures to date") = Sheet18.Range("A13").Value rst.Fields("exposures percentage") = Sheet18.Range("A14").Value rst.Fields("cashbox cashcounts") = Sheet18.Range("A15").Value rst.Fields("cashcounts to date") = Sheet18.Range("A16").Value rst.Fields("cashcounts percentage") = Sheet18.Range("A17").Value rst.Fields("coin machine test") = Sheet18.Range("A18").Value rst.Fields("negotiables") = Sheet18.Range("A19").Value rst.Fields("compliance") = Sheet18.Range("A20").Value rst.Fields("loan exceptions") = Sheet18.Range("A21").Value rst.Fields("cash tracker") = Sheet18.Range("A22").Value rst.Fields("ops grade") = Sheet18.Range("A23").Value rst.Fields("district") = Sheet18.Range("A9").Value  'rst.Fields("Actual") = rst.Fields("Actual") + 100  rst.Update  If CBool(rst.State And adStateOpen) = True Then rst.Close Set rst = Nothing If CBool(cnt.State And adStateOpen) = True Then cnt.Close Set cnt = Nothing MsgBox "I have uploaded your new results" Exit Sub errorhndlr: MsgBox "I wasn't able to upload your numbers for you, I have created an email with your updated numbers that you can send" emailtable End Sub