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

1 回答

• 0

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

  • 使用VBA创建其中包含"Net Use"命令的BAT文件 .

  • 引用文档库的WebDAV地址并查找可用的驱动器号

  • 我怀疑我的任何用户已经拥有26个映射驱动器......） .

  • 一旦文档库被映射，就可以通过使用FileSystemObject命令迭代它，并且可以将项目 Headers 加载到二维数组中 .

  • 必须修改代码以允许3列出子文件夹

  • 必须更改 ListMyFiles sub中文件计数的位置，或者必须将另一个维度添加到数组中 .

  这是代码 - 我将尝试归功于集成到此答案中的所有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年上次触及的文件夹中挖掘出来 .

  回复于 2024-04-29T14:32:18+08:00