Question

我正在处理以下从Excel运行以使用身份验证将文件上传到sharepoint的功能。

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

当我运行它时，我收到以下错误消息：运行时错误＆＃39; -2147012890（80072ee6）＆＃39;自动化错误

我是VBA的新手，欢迎任何建议，谢谢。

Answer 1

我可以通过将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"

结束功能

VBA代码：运行时错误＆＃39; -2147012890（80072ee6）＆＃39;自动化错误

1 个答案: