VBA代码：运行时错误'-2147012890（80072ee6）'自动化错误 [英] VBA code: Run-time error '-2147012890 (80072ee6)' Automation Error
本文介绍了VBA代码：运行时错误'-2147012890（80072ee6）'自动化错误的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
Public Sub CopyToSharePoint（ ）
UserName =username@sharepoint.com
pw =密码
sharepointUrl =https://corp.sharepoint.com/sites/uat/_layouts /15/start.aspx#/a1docsuat/
设置LobjXML = CreateObject（Microsoft.XMLHTTP）
设置fso = CreateObject（Scripting.FileSystemObject）
设置fldr = fso.GetFolder（c：/ vba2sharepoint /）
对于每个f在fldr.Files
sharepointFileName = sharepointUrl& f.Name
'commentedout->如果sharepointFileName Like然后
设置tsIn = f.OpenAsTextStream
sBody = tsIn.ReadAll
tsIn.Close
'commentedout->设置xmlhttp = CreateObject（MSXML2.XMLHTTP。 4.0）
设置xmlhttp =新的MSXML2.XMLHTTP60
xmlhttp.OpenPUT，sharepointFileName，False，UserName，pw
xmlhttp.Send sBody
'commentedout->结束如果
下一个f
End Sub
当我运行我收到以下错误消息：
运行时错误'-2147012890（80072ee6）'自动化错误
我是VBA的新手，任何建议是欢迎，提前感谢。
解决方案
通过将CopyToSharepoint（）函数重新设计到ConnectSharePointOnlineWebPortal中，我可以解决这个问题... 。
公共功能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
表格（GUI）。Range（lblReportMsg）=导航到SharePointOnline网站请稍候...
'Application.ScreenUpdating = False
strProxyInfo = GetProxyInfoForUrl（https：// logi n.microsoftonline.com/\").proxy
'设置zHttp = CreateObject（WinHTTP.WinHTTPrequest.5.1）
'设置zHttp = CreateObject（Msxml2.ServerXMLHTTP.6.0）
设置zHttp = CreateObject（Microsoft.XMLHTTP）
设置ieDom = CreateObject（htmlfile）
strURL =https：//login.microsoftonline .COM / login.srf？
DeleteUrlCacheEntry（strURL）
zHttp.OpenGET，strURL，False
'如果Len（strProxyInfo）> 0然后
'zHttp.setProxy 2，strProxyInfo
'End If
'zHttp.SetCredentials，，HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
'zHttp.option（WinHttpRequestOption_EnableRedirects）= True
zHttp.setRequestHeaderAccept，text / html，application / xhtml + xml，* / *
'zHttp.setRequestHeaderReferer，strRefererURL
zHttp.setRequestHeaderAccept-Language en-us
zHttp.setRequestHeaderUA-CPU，x86
zHttp.setRequestHeaderAccept-Encoding，none
zHttp.setRequestHeaderUser-Agent Mozilla / 5.0（Windows NT 6.1; Trident / 7.0; rv：11.0）像Gecko
zHttp.setRequestHeaderHost，login.microsoftonline.com
zHttp.setRequestHeaderConnection， Keep-Alive
zHttp.setRequestHeaderDNT，1
zHttp.setRequestHeaderCache-Control，no-cache
'zHttp.setRequestHeaderProxy-Connection Keep-Alive
zHttp.setRequestHeaderCookie，MSPShared = 1
zHttp.Send
如果zHttp.Status<> 200然后
ConnectSharePointOnlineWebPortal =失败
退出函数
结束如果
如果InStr（1，zHttp.responseText，退出）> ; 0然后
RetVal = LogoutSharePointOnlineWebPortal
strURL =https://login.microsoftonline.com/login.srf？
DeleteUrlCacheEntry（strURL）
zHttp.OpenGET，strURL，False
'如果Len（strProxyInfo）> 0然后
'zHttp.setProxy 2，strProxyInfo
'End If
'zHttp.SetCredentials，，HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
'zHttp.option（WinHttpRequestOption_EnableRedirects）= True
zHttp.setRequestHeaderAccept，text / html，application / xhtml + xml，* / *
'zHttp.setRequestHeaderReferer，strRefererURL
zHttp.setRequestHeaderAccept-Language en-us
zHttp.setRequestHeaderUA-CPU，x86
zHttp.setRequestHeaderAccept-Encoding，none
zHttp.setRequestHeaderUser-Agent Mozilla / 5.0（Windows NT 6.1; Trident / 7.0; rv：11.0）像Gecko
zHttp.setRequestHeaderHost，login.microsoftonline.com
zHttp.setRequestHeaderConnection， Keep-Alive
zHttp.setRequestHeaderCache-Control，no-cache
zHttp.setRequestHeaderDNT，1
'zHttp.setRequestHeaderProxy-Connection Keep-Alive
zHttp.setRequestHeaderCookie，MSPShared = 1
zHttp.Send
End If
'如果InStr（1，zHttp.responseText，strEmail）> 0然后
'ConnectSharePointOnlineWebPortal =成功
'退出函数
'结束如果
如果InStr（1，zHttp.responseText，用户帐户）= 0然后
ConnectSharePointOnlineWebPortal =失败
退出函数
结束如果
ieDom.body.innerhtml = zHttp.responseText
设置ieInp1 = ieDom.getElementByID（PPFT）
如果ieInp1不是然后
ConnectSharePointOnlineWebPortal =失败
退出函数
结束如果
strPPFT = ieInp1。值
strUnixTime = DateDiff（S，1/1/1970，Now（））
strURL =https://login.microsoftonline.com/GetUserRealm.srf？ login =& modMisc.URLEncode（strEmail）& & handler = 1& extension = 1
DeleteUrlCacheEntry（strURL）
zHttp.OpenGET，strURL，False
'zHttp.SetCredentials，，HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
'zHttp.option（WinHttpRequestOption_EnableRedirects）= True
zHttp.setRequestHeaderAccept，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.setRequestHeaderx-requested-with，XMLHttpRequest
zHttp.setRequestHeaderAccept-Language ，en-us
zHttp.setRequestHeaderUA-CPU，x86
zHttp.setRequestHeaderAccept-Encoding，none
zHttp.setRequestHeaderUser-Agent ，Mozilla / 4.0（兼容; 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.setRequestHeaderHost，login.microsoftonline.com
zHttp.setRequestHeaderConnection，Keep-Alive
zHttp.setRequestHeaderCache-Control，no-缓存
zHttp.setRequestHeaderProxy-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）& &安培;类型= 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.OpenPOST，strURL，False
'zHttp.SetCredentials，，HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
'zHttp。选项（WinHttpRequestOption_EnableRedirects）= True
zHttp.setRequestHeaderAccept，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.setRequestHeaderReferer，strRefererURL
zHttp.setRequestHeaderContent-Type，application / x-www-form-urlencoded
zHttp.setRequestHeaderAccept-Language，en-我们
zHttp.setRequestHeaderUA-CPU，x86
zHttp.setRequestHeaderAccept-Encoding，none
zHttp.setRequestHeader User-Agent，Mozilla / 4.0（兼容; 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.setRequestHeaderHost，login.microsoftonline.co
zHttp.setRequestHeaderConnection，Keep-Alive
zHttp.setRequestHeader Proxy-Connection，Keep-Alive
zHttp.setRequestHeaderContent-Length，Len（strPostBody）
zHttp.setRequestHeaderCache-Control，no-cache
' zHttp.setRequestHeaderCookie，MSPShared = 1; MSPRequ = LT = 1427207617&安培; CO = 1和ID = N; MSPOK = $ UUID-529756bf-935B-430F-b7e4-b8382610ae72; X-MS-网关切片= orgidprod; stsservicecookie = orgidprod
zHttp.Send strPostBody
如果zHttp.Status<> 200然后
ConnectSharePointOnlineWebPortal =失败
退出函数
结束如果
如果InStr（1，zHttp.responseText，退出）> 0然后
ConnectSharePointOnlineWebPortal =成功
退出函数
结束If
'如果InStr（1，zHttp.responseText，strEmail）> 0然后
'ConnectSharePointOnlineWebPortal =成功
'退出函数
'结束如果
ieDom.body.innerhtml = zHttp.responseText
设置ieInp1 = ieDom.getElementByID（fmHF）
如果ieInp1是Nothing然后
ConnectSharePointOnlineWebPortal =失败
退出函数
如果
strAction = ieInp1.Action
设置ieInp1 = ieDom.getElementByID（t）
如果ieInp1是Nothing然后
ConnectSharePointOnlineWebPortal =失败
退出函数
结束如果
strT = ieInp1.Value
strURL = strAction
strR efererURL =https://login.microsoftonline.com/
strPostBody =wbids = 0& wbid = MSFT& t =& modMisc.URLEncode（strT）
DeleteUrlCacheEntry（strURL）
zHttp.OpenPOST，strURL，False
'zHttp.SetCredentials，，HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
'zHttp。选项（WinHttpRequestOption_EnableRedirects）= True
zHttp.setRequestHeaderAccept，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.setRequestHeaderReferer，strRefererURL
zHttp.setRequestHeaderContent-Type，application / x-www-form-urlencoded
zHttp.setRequestHeaderAccept-Language，en-我们
zHttp.setRequestHeaderUA-CPU，x86
zHttp.setRequestHeaderAccept-Encoding，none
zHttp.setRequestHeaderUser-Agent，Mozilla / 4.0（兼容; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322; .NET CLR 2.0.50727; InfoPath.2; .NET CLR 3.0.04506.3 0）
zHttp.setRequestHeaderHost，portal.office.com
zHttp.setRequestHeaderConnection，Keep-Alive
zHttp.setRequestHeaderProxy-Connection Keep-Alive
zHttp.setRequestHeaderContent-Length，Len（strPostBody）
zHttp.setRequestHeaderCache-Control，no-cache
'zHttp.setRequestHeaderCookie ，MSPShared = 1; MSPRequ = LT = 1427207617&安培; CO = 1和ID = N; MSPOK = $ UUID-529756bf-935B-430F-b7e4-b8382610ae72; X-MS-网关切片= orgidprod; stsservicecookie = orgidprod
zHttp.Send strPostBody
如果zHttp.Status<> 200然后
ConnectSharePointOnlineWebPortal =失败
退出函数
结束如果
如果InStr（1，zHttp.responseText，退出）= 0然后
ConnectSharePointOnlineWebPortal =失败
退出函数
结束如果
strURL =https://portal.office.com/Home
DeleteUrlCacheEntry（strURL）
zHttp.OpenGET，strURL，False
'zHttp.SetCredentials ，，HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
'zHttp.option（WinHttpRequestOption_EnableRedirects）= True
zHttp.setRequestHeaderAccept，image / gif，image / x-xbitmap，image / jpeg，image / pjpeg，应用程序/ 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.setRequestHea x-requested-with，XMLHttpRequest
zHttp.setRequestHeaderAccept-Language，en-us
zHttp.setRequestHeaderUA-CPU，x86
zHttp.setRequestHeaderAccept-Encoding，none
zHttp.setRequestHeaderUser-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.setRequestHeaderHost，portal.office.com
zHttp.setRequestHeaderConnection，Keep-Alive
zHttp.setRequestHeader Proxy-Connection，Keep-Alive
zHttp.setRequestHeaderCache-Control，no-cache
zHttp.Send
如果InStr（1，zHttp。
ConnectSharePointOnlineWebPortal =失败
退出函数
如果
如果InStr（1，zHttp.responseText，strEmail） = 0然后
ConnectSharePointOnlineWebPortal =失败
退出函数
结束如果
ConnectSharePointOnlineWebPortal =成功
结束功能
I am working on the following function that runs from Excel to upload files to sharepoint using authentication.
Public Sub CopyToSharePoint()
UserName = "username@sharepoint.com"
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
When I run it, I get the following error message: Run-time error '-2147012890 (80072ee6)' Automation Error
I'm new to VBA any advise is welcome, thanks in advance.
解决方案
I was able to resolve this issue by redesigning the CopyToSharepoint() function into 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"
End Function
这篇关于VBA代码：运行时错误'-2147012890（80072ee6）'自动化错误的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
