0

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

  • SharePoint 网站有一个 https 地址
  • 我查看了有关引用 scrrun.dll 的线程,但它不起作用,因为我无法更改本地域上的信任设置
  • 这个线程看起来很有希望,但它似乎再次使用 FileSystemObject 这可能是我的挂断。
  • SharePoint stackexchange 网站上的这个线程非常适合将文件列表作为工作表对象读取,但我不知道如何将其调整为直接推送到数组中。
  • 我倾向于收到错误 76“错误路径”,但我可以轻松地在本地 (C:) 文件上执行。
  • 我曾尝试使用 WebDAV 地址 - 就像我给这个线程的答案一样- 但它也遇到了“错误路径”错误。

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

4

1 回答 1

0

好的,我要自己回答。我不是 100% 对我的解决方案感到兴奋,但它在我的限制范围内就足够了。以下是高级别要点:

  • 使用 VBA 创建包含“Net Use”命令的 BAT 文件。
  • 参考文档库的WebDAV地址,找到可用的盘符
    • 怀疑我的任何用户已经拥有 26 个映射驱动器...)。
  • 一旦文档库被映射,就可以使用 FileSystemObject 命令对其进行迭代,并且可以将项目标题加载到二维数组中。
  • 必须修改代码以允许列出 3 个子文件夹
    • 必须更改 sub中文件计数的位置,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回答找到空的网络驱动器;感谢 ozgrid 上的 Kenneth Hobson 对在目录中列出文件的扩展回答。其余的代码很古老,我从 2010 年最后一次接触的文件夹中挖掘出来。

于 2013-09-10T19:23:54.840 回答