0

所以我有我的宏设置和它的工作，超链接部分和我制作的文件列表部分，但是他们正在挑选我似乎在我的文件中找不到的文件

（即：运行表\~$RUNSHEET - # 1-H.xlsx）

当我直接转到文件并打开文件夹设置以查看隐藏和什么结时，文件不在那里，它们似乎是我的文件工作时留下的临时文件。

无论如何我可以更改我的代码以排除“〜$”文件吗？

这是我的代码，第一个是目录列表器：

Sub ListFilesAndSubfolders()

  Dim FSO As Object
  Dim rsFSO As Object
  Dim baseFolder As Object
  Dim file As Object
  Dim folder As Object
  Dim row As Integer
  Dim name As String

  'Get the current folder
  Set FSO = CreateObject("scripting.filesystemobject")
  Set baseFolder = FSO.GetFolder(ThisWorkbook.Path)
  Set FSO = Nothing

  'Get the row at which to insert
  row = Range("A65536").End(xlUp).row + 1

  'Create the recordset for sorting
  Set rsFSO = CreateObject("ADODB.Recordset")
  With rsFSO.Fields
    .Append "Name", 200, 200
    .Append "Type", 200, 200
  End With
  rsFSO.Open

  ' Traverse the entire folder tree
  TraverseFolderTree baseFolder, baseFolder, rsFSO
  Set baseFolder = Nothing

  'Sort by type and name
  rsFSO.Sort = "Type ASC, Name ASC "
  rsFSO.MoveFirst

  'Populate the first column of the sheet
  While Not rsFSO.EOF
    name = rsFSO("Name").value
    If (name <> ThisWorkbook.name) Then
      Cells(row, 1).Formula = name
      row = row + 1
    End If
    rsFSO.MoveNext
  Wend

  'Close the recordset
  rsFSO.Close
  Set rsFSO = Nothing

End Sub

Private Sub TraverseFolderTree(ByVal parent As Object, ByVal node As Object, ByRef rs As Object)

  'List all files
  For Each file In node.Files

    Dim name As String
    name = Mid(file.Path, Len(parent.Path) + 2)

    rs.AddNew
    rs("Name") = name
    rs("Type") = "FILE"
    rs.Update
  Next

  'List all folders
  For Each folder In node.SubFolders
    TraverseFolderTree parent, folder, rs
  Next

End Sub

第二个是超链接代码：

Sub hyperlinker()

  Dim MOG As Object
  Dim rsMOG As Object
  Dim PrimeF As Object
  Dim Bit As Object
  Dim Foder As Object
  Dim Linger As Integer
  Dim Enigma As String
  Dim way As String


  'Get the current folder
  Set MOG = CreateObject("scripting.filesystemobject")
  Set PrimeF = MOG.GetFolder(ThisWorkbook.Path)
  Set MOG = Nothing

  'Get the row at which to insert
   Linger = Range("U65536").End(xlUp).row + 1

  'Create the recordset for sorting
  Set rsMOG = CreateObject("ADODB.Recordset")
  With rsMOG.Fields
    .Append "Way", 200, 200
    .Append "Enigma", 200, 200
    .Append "Bit", 200, 200
  End With
  rsMOG.Open

  ' Traverse the entire folder tree
  TraverseFolderTree PrimeF, PrimeF, rsMOG
  Set PrimeF = Nothing

  'Sort by type and name
  rsMOG.Sort = "Bit ASC, Enigma ASC "
  rsMOG.MoveFirst

  'Populate the first column of the sheet
   While Not rsMOG.EOF
    Enigma = rsMOG("Enigma").value
    way = rsMOG("Way").value
    If (Enigma <> ThisWorkbook.name) Then
      ActiveSheet.Hyperlinks.Add Anchor:=Cells(Linger, 21), Address:=way, TextToDisplay:=Enigma
      Linger = Linger + 1
    End If
    rsMOG.MoveNext
  Wend

  'Close the recordset
  rsMOG.Close
  Set rsMOG = Nothing

End Sub

Private Sub TraverseFolderTree(ByVal parent As Object, ByVal node As Object, ByRef rs As Object)

  'List all files
  For Each Bit In node.Files

    Dim Enigma As String
    Enigma = Mid(Bit.Path, Len(parent.Path) + 2)

    Dim way As String
    way = Mid(Bit.Path, Len(parent.Path) + 2)

    rs.AddNew
    rs("Way") = way
    rs("Enigma") = Enigma
    rs("Bit") = "Bit"
    rs.Update
  Next

  'List all folders
  For Each Foder In node.SubFolders
    TraverseFolderTree parent, Foder, rs
  Next

End Sub

我需要从我的列表中删除这些额外的“~$”数据，有些列表可能是几百个文件，所以挑选数据会非常耗时。

有任何想法吗？

另一个提示，我是否可以删除 .xlsx 扩展名，因为我的所有数据中都包含 excel 文档？

4

1 回答 1

0

在目录列表器中进行以下更改：

'List all files
  For Each file In node.Files
    if InStr(file.Path, "~$") > 0 then
      Dim name As String
      name = Mid(file.Path, Len(parent.Path) + 2)

      rs.AddNew
      rs("Name") = name
      rs("Type") = "FILE"
      rs.Update
    end if
  Next

在超链接器代码中更改此：

  For Each Bit In node.Files
    if InStr(file.Path, "~$") > 0 then
      Dim Enigma As String
      Enigma = Mid(Bit.Path, Len(parent.Path) + 2)

      Dim way As String
      way = Mid(Bit.Path, Len(parent.Path) + 2)

      rs.AddNew
      rs("Way") = way
      rs("Enigma") = Enigma
      rs("Bit") = "Bit"
      rs.Update
    End If
  Next
于 2013-10-03T20:24:06.003 回答