Question

我需要使用Excel VBA将SharePoint文档库中所有文档的所有项目标题直接读入数组。我似乎无法成功使用FileSystemObject，我不想将文档库映射到驱动器号，因为宏将被分发和广泛使用。

SharePoint网站具有https地址
我查看了this thread有关引用scrrun.dll的信息，但由于我无法更改本地域的信任设置，因此无法正常工作
This thread看起来很有希望，但似乎再次使用FileSystemObject，这可能是我的挂断。
This thread可以很好地读取作为工作表对象的文件列表，但我不知道如何将其直接推送到数组中。
我倾向于收到错误76“错误路径”，但我很容易在本地（C :)文件上执行。
我尝试过使用WebDAV地址 - 就像我给this thread的答案一样 - 但它也遇到了“错误路径”错误。

必须有一种方法可以将SharePoint文档库的内容直接读入不违反本地安全策略且不依赖于Excel工作表的数组中。

Answer 1

好的我会自己回答。我对我的解决方案并不是百分之百的兴奋，但它在我的限制范围内就足够了。以下是高级别的要点：

使用VBA创建其中包含“Net Use”命令的BAT文件。
引用文档库的WebDAV地址并查找可用的驱动器号
- 我怀疑我的任何用户已经拥有26个映射驱动器......）。
一旦文档库被映射，就可以通过使用FileSystemObject命令进行迭代，并且可以将项目标题加载到二维数组中。
必须修改代码以允许3列出子文件夹
- 必须更改ListMyFiles子文件中文件计数的位置，或者必须将另一个维度添加到数组中。

以下是代码 - 我将尝试归功于集成到此答案中的所有Stack解决方案：

 Private Sub List_Files()
    Const MY_FILENAME = "C:\BAT.BAT"
    Const MY_FILENAME2 = "C:\DELETE.BAT"

    Dim i As Integer
    Dim FileNumber As Integer
    Dim FileNumber2 As Integer
    Dim retVal As Variant
    Dim DriveLetter As String
    Dim TitleArray()

    FileNumber = FreeFile
     'create batch file

    For i = Asc("Z") To Asc("A") Step -1
    DriveLetter = Chr(i)
    If Not oFSO.DriveExists(DriveLetter) Then
        Open MY_FILENAME For Output As #FileNumber
        'Use CHR(34) to add escape quotes to the command prompt line
    Print #FileNumber, "net use " & DriveLetter & ": " & Chr(34) & "\\sharepoint.site.com@SSL\DavWWWRoot\cybertron\HR\test\the_lab\Shared Documents" & Chr(34) & " > H:\Log.txt"
        Close #FileNumber
      Exit For
    End If
  Next i

     'run batch file
    retVal = Shell(MY_FILENAME, vbNormalFocus)

     ' NOTE THE BATCH FILE WILL RUN, BUT THE CODE WILL CONTINUE TO RUN.
     'This area can be used to evaluate return values from the bat file
    If retVal = 0 Then
         MsgBox "An  Error Occured"
        Close #FileNumber
        End
    End If

'This calls a function that will return the array of item titles and other metadata
    ListMyFiles DriveLetter & ":\", False, TitleArray()

    'Create code here to work with the data contained in TitleArray()

    'Now remove the network drive and delete the bat files
    FileNumber2 = FreeFile

    Open MY_FILENAME2 For Output As #FileNumber2
    Print #FileNumber2, "net use " & DriveLetter & ": /delete > H:\Log2.txt"
    Close #FileNumber2

     retVal = Shell(MY_FILENAME2, vbNormalFocus)
     'Delete batch file
    Kill MY_FILENAME
    Kill MY_FILENAME2

End Sub

这是一个将读取目录并返回文件信息数组的函数：

Sub ListMyFiles(mySourcePath As String, IncludeSubFolders As Boolean, TitleArray())
    Dim MyObject As Object
    Dim mySource As Object
    Dim myFile As File
    Dim mySubFolder As folder
    Dim FileCount As Integer
    Dim CurrentFile As Integer
    'Dim TitleArray()
    Dim PropertyCount As Integer
    CurrentFile = 0
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)

    FileCount = mySource.Files.Count
    ReDim TitleArray(0 To FileCount - 1, 4)

    'On Error Resume Next
    For Each myFile In mySource.Files
        PropertyCount = 1
        TitleArray(CurrentFile, PropertyCount) = myFile.Path
        PropertyCount = PropertyCount + 1
        TitleArray(CurrentFile, PropertyCount) = myFile.Name
        PropertyCount = PropertyCount + 1
        TitleArray(CurrentFile, PropertyCount) = myFile.Size
        PropertyCount = PropertyCount + 1
        TitleArray(CurrentFile, PropertyCount) = myFile.DateLastModified
        CurrentFile = CurrentFile + 1
    Next

    'The current status of this code does not support subfolders.
    'An additional dimension or a different counting method would have to be used
    If IncludeSubFolders = True Then
        For Each mySubFolder In mySource.SubFolders
            Call ListMyFiles(mySubFolder.Path, True, TitleArray())
        Next
    End If
End Sub

感谢Chris Hayes his answer寻找空网络驱动器;感谢Kenneth Hobson在ozgrid上his expanded answer列出目录中的文件。其余代码很古老，我从2010年上次触及的文件夹中挖掘出来。

使用Excel VBA将SharePoint文档库中的项目标题读入阵列

1 个答案: