Excel VBA - Open workbook in sharepoint fails until I log into sharepoint and access file

问题

EDIT 3/31/14 -- No responses...still baffled by this behavior. Bump! Any thoughts?

I have set up some code in an Excel workbook on my local harddrive that navigates to a corporate sharepoint site, browses through a set of folders, and when it comes upon a file, it opens it and pulls some data down. I pieced a lot of it together from other posts and from a previous question I asked.

Here is the issue I have. If I run it without first going into the Sharepoint site and opening a file, it throws an error. However, once I have done so, it works fine. My only thought is that the Sharepoint site is expecting my corporate credentials (username and password), and since I'm not passing that in my

Set oWB = Workbooks.Open(MyPath)

command, it is denying me access. The error is throwing a description...just a long int value.

Here's the full code, with confidential stuff stripped out It basically uses recursion to get to the root child nodes. So I guess my question is two-fold...1) what's causing the issue; 2) if it is the network credentials, can I pass both a username and password somehow?:

Public Stack As New Collection
Public PrintLine As String
Public Spaces As String
Public fnum As Integer
Public outputFile As String


Sub NavigateSharepointSite()

    On Error Resume Next
    Dim spSite As String, spDir As String, spFile As String, url As String

    spSite = "https://myteamssite"
    spDir = ""
    spFile = ""
    url = spSite & spDir & spFile
    Stack.Add (Array(spSite, spDir, spFile, url, "d", 0))

    NavigateFolder spSite, spDir, url, 0

End Sub

Sub NavigateFolder(spSite As String, spDir As String, url As String, level As Integer)

    Dim davDir As New ADODB.Record
    Dim davFile As New ADODB.Record
    Dim davFiles As New ADODB.Recordset
    Dim isDir As Boolean
    Dim tempURL As String
    On Error GoTo showErr
    tempURL = "URL=" & url
    davDir.Open "", tempURL, adModeReadWrite, adFailIfNotExists, adDelayFetchStream
    If davDir.RecordType = adCollectionRecord Then      
        Set davFiles = davDir.GetChildren()  ''Returns recordset of all child records from parent
        Do While Not davFiles.EOF


            davFile.Open davFiles, , adModeRead
            isDir = davFile.Fields("RESOURCE_ISCOLLECTION").Value
            If Not isDir Then ''if not children

                spFile = Replace(davFile.Fields("RESOURCE_PARSENAME").Value, "%20", " ")
                url = spSite & spDir & "/" & spFile
                Stack.Add (Array(spSite, spDir, spFile, url, "f", level))
                If spFile Like "Quarterly*" Then

                   testthis (url)
                End If

            Else

                level = level + 1
                url = Replace(davFile.Fields("RESOURCE_ABSOLUTEPARSENAME").Value, "%20", " ")
                spDir = Right(url, Len(url) - Len(spSite))
                Stack.Add (Array(spSite, spDir, "", url, "d", level))

                NavigateFolder spSite, spDir, url, level
                level = level - 1
            End If
            davFile.Close
            davFiles.MoveNext
        Loop
    End If
    Set davFiles = Nothing
    davDir.Close
    Set davDir = Nothing


    GoTo noErr
    showErr:
    Call MsgBox(Err.Number & ": " & Err.Description & Chr(10) _
    & "spSite=" & spSite & Chr(10) _
    & "spDir= " & spDir & Chr(10) _
    & "spFile=" & spFile, vbOKOnly, "Error")

    noErr:
End Sub



Private Function testthis(MyPath As String)
    Dim oWB As Workbook '', MyPath As String

    Debug.Print MyPath
    If Workbooks.CanCheckOut(MyPath) = True Then          
        Set oWB = Workbooks.Open(MyPath)
        oWB.Application.DisplayAlerts = False
        Debug.Print (oWB.Worksheets(1).Name)
        oWB.Close False
        Set oWB = Nothing

    Else
        MsgBox ("File on Sharepoint can NOT be checked out." + Chr(13) + _
                "Make sure no one else is working in the file." + Chr(13) + _
                "Including yourself.")
        Exit Function
    End If


End Function

回答1:

You could try sending a HTTP request with your credentials, but the system will probably still ask for your credentials when you get to the point of opening the workbook, all this will really do is start the SharePoint session server-side which could possible stop the issue you're currently having (if that issue is due to authentication). Try the below code before you attempt to open the workbook:

With CreateObject("WinHTTP.WinHttpRequest.5.1")
    .Open "GET", spSite, False
    .SetCredentials  "Domain\username", "Password", 0 'Change as required.
    .Send
End With

Another option I tend to use with SharePoint, is to map a persistent network drive to the SharePoint directory and save your credentials at the point of connecting the drive - then just point to that drive in your code as you would any other drive.

回答2:

Really more of a work around than an answer but this might solve your issue for the time being ...

add the "Microsoft Internet Controls" Reference Library and add this to the beginning

Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False

ie.Navigate (YourSite)

ie.quit

Hopefully this will trigger your authentication and allow you to connect to the workbook...

来源：https://stackoverflow.com/questions/22078727/excel-vba-open-workbook-in-sharepoint-fails-until-i-log-into-sharepoint-and-ac