列出目錄中的文件夾，更新功能

我試圖獲取目錄中所有文件夾的列表。並且有一個按鈕可以在列表中啓用更新，而無需每次都重新創建。所以只列出不在Excel表格中的新文件夾。列出目錄中的文件夾，更新功能

這是我工作的代碼。但我希望它能夠搜索工作表，如果該文件夾已經存在，如果它然後跳過它，如果不是添加它。一旦更新它完成了名C列的過濾器存儲材料之前

Sub folder_names_including_subfolder() 
Application.ScreenUpdating = False 
Dim fldpath 
Dim fso As Object, j As Long, folder1 As Object 
If ActiveSheet.Name = "test" Then 
    fldpath = "Z:\\" 
ElseIf ActiveSheet.Name = "test1" Then 
    fldpath = "Y:\\" 
End If 
Cells(3, 1).Value = fldpath 
Cells(4, 1).Value = "Path" 
Cells(4, 2).Value = "Dir" 
Cells(4, 3).Value = "Name" 
Cells(4, 4).Value = "Folder Size" 
Cells(4, 5).Value = "Date Created" 
Cells(4, 6).Value = "Date Last Modified" 
Cells(4, 7).Value = "Codec" 
Set fso = CreateObject("Scripting.FileSystemObject") 
Set folder1 = fso.GetFolder(fldpath) 
get_sub_folder folder1 
Set fso = Nothing 
Range("A3").Font.Size = 9 
ActiveWindow.DisplayGridlines = False 
Range("A3:G" & Range("A4").End(xlDown).Row).Font.Size = 9 
Range("A4:G4").Interior.Color = vbCyan 
Application.ScreenUpdating = True 
End Sub 

Sub get_sub_folder(ByRef prntfld As Object) 
Dim SubFolder As Object, subfld As Object, j As Long 
For Each SubFolder In prntfld.SubFolders 
j = Range("A3").End(xlDown).Row + 1 
Cells(j, 1).Value = SubFolder.Path 
Cells(j, 2).Value = Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")) 
Cells(j, 3).Value = SubFolder.Name 
Cells(j, 4).Value = Application.WorksheetFunction.RoundDown((((SubFolder.Size/1024)/1024)/1024), 2) & " " & "GB" 
Cells(j, 5).Value = SubFolder.DateCreated 
Cells(j, 6).Value = SubFolder.DateLastModified 
With Cells(j, 7).Validation 
     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ 
     xlBetween, Formula1:="=Sheet3!$A$1:$A$5" 
     .IgnoreBlank = True 
     .InCellDropdown = True 
     .InputTitle = "" 
     .ErrorTitle = "" 
     .InputMessage = "" 
     .ErrorMessage = "" 
     .ShowInput = True 
     .ShowError = True 
End With 
Next SubFolder 
For Each subfld In prntfld.SubFolders 
get_sub_folder subfld 
Next subfld 
Columns("C:F").AutoFit 
Columns("G").ColumnWidth = 10 
End Sub

來源

2016-02-05 atame

一個COUNTIF會做的伎倆，所以COUNTIF（「A：A」，佛羅里達州。 subfoldername）= 0 –

只是測試：

For Each SubFolder In prntfld.SubFolders 
    checkit = SubFolder.Name 
    If Application.WorksheetFunction.CountIf(Range("C:C"), checkit) = 0 Then 
     j = Range("A3").End(xlDown).Row + 1 
     Cells(j, 1).Value = SubFolder.Path 
     Cells(j, 2).Value = Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")) 
     Cells(j, 3).Value = SubFolder.Name 
     Cells(j, 4).Value = Application.WorksheetFunction.RoundDown((((SubFolder.Size/1024)/1024)/1024), 2) & " " & "GB" 
     Cells(j, 5).Value = SubFolder.DateCreated 
     Cells(j, 6).Value = SubFolder.DateLastModified 
     With Cells(j, 7).Validation 
       .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ 
       xlBetween, Formula1:="=Sheet3!$A$1:$A$5" 
       .IgnoreBlank = True 
       .InCellDropdown = True 
       .InputTitle = "" 
       .ErrorTitle = "" 
       .InputMessage = "" 
       .ErrorMessage = "" 
       .ShowInput = True 
       .ShowError = True 
     End With 
    End If 
Next SubFolder

來源

2016-02-05 17:39:09

列出目錄中的文件夾，更新功能

回答

相關問題