Код 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" 

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

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