Код VBA: ошибка времени выполнения '-2147012890 (80072ee6)' Ошибка автоматизации

Я работаю над следующей функцией, которая запускается из Excel для загрузки файлов в sharepoint с использованием аутентификации.

Public Sub CopyToSharePoint() UserName = "[email protected]" pw = "password" sharepointUrl = ""https://corp.sharepoint.com/sites/uat/_layouts/15/start.aspx#/a1docsuat/" Set LobjXML = CreateObject("Microsoft.XMLHTTP") Set fso = CreateObject("Scripting.FileSystemObject") Set fldr = fso.GetFolder("c:/vba2sharepoint/") For Each f In fldr.Files sharepointFileName = sharepointUrl & f.Name 'commentedout-> If sharepointFileName Like "*.txt" Then Set tsIn = f.OpenAsTextStream sBody = tsIn.ReadAll tsIn.Close 'commentedout-> Set xmlhttp = CreateObject("MSXML2.XMLHTTP.4.0") Set xmlhttp = New MSXML2.XMLHTTP60 xmlhttp.Open "PUT", sharepointFileName, False, UserName, pw xmlhttp.Send sBody 'commentedout-> End If Next f End Sub 

Когда я запустил его, я получаю следующее сообщение об ошибке: Ошибка времени выполнения «-2147012890 (80072ee6)» Ошибка автоматизации

Я новичок в VBA, любой совет приветствуется, спасибо заранее.

Я смог решить эту проблему, переработав функцию CopyToSharepoint () в ConnectSharePointOnlineWebPortal ….

 Public Function ConnectSharePointOnlineWebPortal(ByVal strEmail As String, ByVal strPassword As String) As String Dim strPPFT As String Dim strUnixTime As String Dim strT As String Dim strAction As String ConnectSharePointOnlineWebPortal = "Failed" Application.ScreenUpdating = True Sheets("GUI").Range("lblReportMsg") = "Navigating to SharePointOnline website. Please wait..." 'Application.ScreenUpdating = False strProxyInfo = GetProxyInfoForUrl("https://login.microsoftonline.com/").proxy 'Set zHttp = CreateObject("WinHTTP.WinHTTPrequest.5.1") 'Set zHttp = CreateObject("Msxml2.ServerXMLHTTP.6.0") Set zHttp = CreateObject("Microsoft.XMLHTTP") Set ieDom = CreateObject("htmlfile") strURL = "https://login.microsoftonline.com/login.srf?" DeleteUrlCacheEntry (strURL) zHttp.Open "GET", strURL, False 'If Len(strProxyInfo) > 0 Then ' zHttp.setProxy 2, strProxyInfo 'End If 'zHttp.SetCredentials "", "", HTTPREQUEST_SETCREDENTIALS_FOR_SERVER 'zHttp.option(WinHttpRequestOption_EnableRedirects) = True zHttp.setRequestHeader "Accept", "text/html, application/xhtml+xml, */*" 'zHttp.setRequestHeader "Referer", strRefererURL zHttp.setRequestHeader "Accept-Language", "en-us" zHttp.setRequestHeader "UA-CPU", "x86" zHttp.setRequestHeader "Accept-Encoding", "none" zHttp.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Trident/7.0; rv:11.0) like Gecko" zHttp.setRequestHeader "Host", "login.microsoftonline.com" zHttp.setRequestHeader "Connection", "Keep-Alive" zHttp.setRequestHeader "DNT", "1" zHttp.setRequestHeader "Cache-Control", "no-cache" 'zHttp.setRequestHeader "Proxy-Connection", "Keep-Alive" zHttp.setRequestHeader "Cookie", "MSPShared=1" zHttp.Send If zHttp.Status <> 200 Then ConnectSharePointOnlineWebPortal = "Failed" Exit Function End If If InStr(1, zHttp.responseText, "Sign out") > 0 Then RetVal = LogoutSharePointOnlineWebPortal strURL = "https://login.microsoftonline.com/login.srf?" DeleteUrlCacheEntry (strURL) zHttp.Open "GET", strURL, False 'If Len(strProxyInfo) > 0 Then ' zHttp.setProxy 2, strProxyInfo 'End If 'zHttp.SetCredentials "", "", HTTPREQUEST_SETCREDENTIALS_FOR_SERVER 'zHttp.option(WinHttpRequestOption_EnableRedirects) = True zHttp.setRequestHeader "Accept", "text/html, application/xhtml+xml, */*" 'zHttp.setRequestHeader "Referer", strRefererURL zHttp.setRequestHeader "Accept-Language", "en-us" zHttp.setRequestHeader "UA-CPU", "x86" zHttp.setRequestHeader "Accept-Encoding", "none" zHttp.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Trident/7.0; rv:11.0) like Gecko" zHttp.setRequestHeader "Host", "login.microsoftonline.com" zHttp.setRequestHeader "Connection", "Keep-Alive" zHttp.setRequestHeader "Cache-Control", "no-cache" zHttp.setRequestHeader "DNT", "1" 'zHttp.setRequestHeader "Proxy-Connection", "Keep-Alive" zHttp.setRequestHeader "Cookie", "MSPShared=1" zHttp.Send End If 'If InStr(1, zHttp.responseText, strEmail) > 0 Then ' ConnectSharePointOnlineWebPortal = "Success" ' Exit Function 'End If If InStr(1, zHttp.responseText, "User account") = 0 Then ConnectSharePointOnlineWebPortal = "Failed" Exit Function End If ieDom.body.innerhtml = zHttp.responseText Set ieInp1 = ieDom.getElementByID("PPFT") If ieInp1 Is Nothing Then ConnectSharePointOnlineWebPortal = "Failed" Exit Function End If strPPFT = ieInp1.Value strUnixTime = DateDiff("S", "1/1/1970", Now()) strURL = "https://login.microsoftonline.com/GetUserRealm.srf?login=" & modMisc.URLEncode(strEmail) & "&handler=1&extended=1" DeleteUrlCacheEntry (strURL) zHttp.Open "GET", strURL, False 'zHttp.SetCredentials "", "", HTTPREQUEST_SETCREDENTIALS_FOR_SERVER 'zHttp.option(WinHttpRequestOption_EnableRedirects) = True zHttp.setRequestHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, application/xaml+xml, application/vnd.ms-xpsdocument, application/x-ms-xbap, application/x-ms-application, */*" strRefererURL = "https://login.microsoftonline.com/" zHttp.setRequestHeader "x-requested-with", "XMLHttpRequest" zHttp.setRequestHeader "Accept-Language", "en-us" zHttp.setRequestHeader "UA-CPU", "x86" zHttp.setRequestHeader "Accept-Encoding", "none" zHttp.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322; .NET CLR 2.0.50727; InfoPath.2; .NET CLR 3.0.04506.30)" zHttp.setRequestHeader "Host", "login.microsoftonline.com" zHttp.setRequestHeader "Connection", "Keep-Alive" zHttp.setRequestHeader "Cache-Control", "no-cache" zHttp.setRequestHeader "Proxy-Connection", "Keep-Alive" zHttp.Send strURL = "https://login.microsoftonline.com/ppsecure/post.srf?bk=" & strUnixTime strRefererURL = "https://login.microsoftonline.com/" strPostBody = "login=" & modMisc.URLEncode(strEmail) & "&passwd=" & modMisc.URLEncode(strPassword) & "&PPSX=PassportR&PPFT=" & modMisc.URLEncode(strPPFT) & "&type=11&LoginOptions=3&NewUser=1&idsbho=1&PwdPad=&sso=&vv=&uiver=1&i12=1&i13=MSIE&i14=8.0&i15=1280&i16=851" DeleteUrlCacheEntry (strURL) zHttp.Open "POST", strURL, False 'zHttp.SetCredentials "", "", HTTPREQUEST_SETCREDENTIALS_FOR_SERVER 'zHttp.option(WinHttpRequestOption_EnableRedirects) = True zHttp.setRequestHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, application/xaml+xml, application/vnd.ms-xpsdocument, application/x-ms-xbap, application/x-ms-application, */*" zHttp.setRequestHeader "Referer", strRefererURL zHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" zHttp.setRequestHeader "Accept-Language", "en-us" zHttp.setRequestHeader "UA-CPU", "x86" zHttp.setRequestHeader "Accept-Encoding", "none" zHttp.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322; .NET CLR 2.0.50727; InfoPath.2; .NET CLR 3.0.04506.30)" zHttp.setRequestHeader "Host", "login.microsoftonline.co" zHttp.setRequestHeader "Connection", "Keep-Alive" zHttp.setRequestHeader "Proxy-Connection", "Keep-Alive" zHttp.setRequestHeader "Content-Length", Len(strPostBody) zHttp.setRequestHeader "Cache-Control", "no-cache" 'zHttp.setRequestHeader "Cookie", "MSPShared=1; MSPRequ=lt=1427207617&co=1&id=N; MSPOK=$uuid-529756bf-935b-430f-b7e4-b8382610ae72; x-ms-gateway-slice=orgidprod; stsservicecookie=orgidprod" zHttp.Send strPostBody If zHttp.Status <> 200 Then ConnectSharePointOnlineWebPortal = "Failed" Exit Function End If If InStr(1, zHttp.responseText, "Sign out") > 0 Then ConnectSharePointOnlineWebPortal = "Success" Exit Function End If 'If InStr(1, zHttp.responseText, strEmail) > 0 Then ' ConnectSharePointOnlineWebPortal = "Success" ' Exit Function 'End If ieDom.body.innerhtml = zHttp.responseText Set ieInp1 = ieDom.getElementByID("fmHF") If ieInp1 Is Nothing Then ConnectSharePointOnlineWebPortal = "Failed" Exit Function End If strAction = ieInp1.Action Set ieInp1 = ieDom.getElementByID("t") If ieInp1 Is Nothing Then ConnectSharePointOnlineWebPortal = "Failed" Exit Function End If strT = ieInp1.Value strURL = strAction strRefererURL = "https://login.microsoftonline.com/" strPostBody = "wbids=0&wbid=MSFT&t=" & modMisc.URLEncode(strT) DeleteUrlCacheEntry (strURL) zHttp.Open "POST", strURL, False 'zHttp.SetCredentials "", "", HTTPREQUEST_SETCREDENTIALS_FOR_SERVER 'zHttp.option(WinHttpRequestOption_EnableRedirects) = True zHttp.setRequestHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, application/xaml+xml, application/vnd.ms-xpsdocument, application/x-ms-xbap, application/x-ms-application, */*" zHttp.setRequestHeader "Referer", strRefererURL zHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" zHttp.setRequestHeader "Accept-Language", "en-us" zHttp.setRequestHeader "UA-CPU", "x86" zHttp.setRequestHeader "Accept-Encoding", "none" zHttp.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322; .NET CLR 2.0.50727; InfoPath.2; .NET CLR 3.0.04506.30)" zHttp.setRequestHeader "Host", "portal.office.com" zHttp.setRequestHeader "Connection", "Keep-Alive" zHttp.setRequestHeader "Proxy-Connection", "Keep-Alive" zHttp.setRequestHeader "Content-Length", Len(strPostBody) zHttp.setRequestHeader "Cache-Control", "no-cache" 'zHttp.setRequestHeader "Cookie", "MSPShared=1; MSPRequ=lt=1427207617&co=1&id=N; MSPOK=$uuid-529756bf-935b-430f-b7e4-b8382610ae72; x-ms-gateway-slice=orgidprod; stsservicecookie=orgidprod" zHttp.Send strPostBody If zHttp.Status <> 200 Then ConnectSharePointOnlineWebPortal = "Failed" Exit Function End If If InStr(1, zHttp.responseText, "Sign out") = 0 Then ConnectSharePointOnlineWebPortal = "Failed" Exit Function End If strURL = "https://portal.office.com/Home" DeleteUrlCacheEntry (strURL) zHttp.Open "GET", strURL, False 'zHttp.SetCredentials "", "", HTTPREQUEST_SETCREDENTIALS_FOR_SERVER 'zHttp.option(WinHttpRequestOption_EnableRedirects) = True zHttp.setRequestHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, application/xaml+xml, application/vnd.ms-xpsdocument, application/x-ms-xbap, application/x-ms-application, */*" strRefererURL = "https://login.microsoftonline.com/" zHttp.setRequestHeader "x-requested-with", "XMLHttpRequest" zHttp.setRequestHeader "Accept-Language", "en-us" zHttp.setRequestHeader "UA-CPU", "x86" zHttp.setRequestHeader "Accept-Encoding", "none" zHttp.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322; .NET CLR 2.0.50727; InfoPath.2; .NET CLR 3.0.04506.30)" zHttp.setRequestHeader "Host", "portal.office.com" zHttp.setRequestHeader "Connection", "Keep-Alive" zHttp.setRequestHeader "Proxy-Connection", "Keep-Alive" zHttp.setRequestHeader "Cache-Control", "no-cache" zHttp.Send If InStr(1, zHttp.responseText, "Sign out") = 0 Then ConnectSharePointOnlineWebPortal = "Failed" Exit Function End If If InStr(1, zHttp.responseText, strEmail) = 0 Then ConnectSharePointOnlineWebPortal = "Failed" Exit Function End If ConnectSharePointOnlineWebPortal = "Success" 

Конечная функция

Interesting Posts

Автоматически включать изображения и звуковые файлы в столбцах excel на основе имени файла в другом столбце

Проектирование цикла python3 For, который присваивает значениям ячеек из двух столбцов листа Excel переменным в процессе Selenium и циклам для всех строк

Разделить файл в excel для исключения ограничения строки

Сумма Excel, если год равен

Добавление нескольких словарных слов для автокоррекции для достижения одного выстрела?

Чтобы сгенерировать результаты тестового примера Android JUnit после завершения теста

Как загрузить массовые изображения, используя путь в листе excel

Excel VBA: удаление всей строки в двух таблицах

Математическое уравнение в Excel с использованием двух переменных

доступ к данным командной строки в Excel VBA не удается

Ссылка на ячейку в другой книге. И сделайте мой запрос не обновленным, если значения равны

VBA Lookup, возвращайте все уникальные значения, связанные со значением поиска (в текстовом поле userform)

Найти точное соответствие текста в массиве excel (с другого листа) и отобразить определенное значение ячейки из той же строки

Ссылка на ячейку, содержащую путь к файлу

Использование VBA для изменения цвета штриха на основе значения ID в массиве

Давайте будем гением компьютера.