我想要实现的是我目前有一个（主要）文件夹，里面装满了许多子文件夹，这些文件夹有时会被拖放。偶然地放入另一个子文件夹。
我有一个CSV文件，其中包含当前（主）文件夹列表的所有名称，我应该根据（主）文件夹中找到的当前版本的子文件夹进行检查并输出一个消息框与匹配文件和丢失文件的结果。
这是我到目前为止所获得的代码，但我不确定如何根据CSV文件检查文件夹列表。
从CSV文件中读取数据。
'Holds Data from CSV file
Dim arrValue As String()
'create a new TextFieldParser and opens the file
Using MyReader As New Microsoft.VisualBasic.FileIO.TextFieldParser("C:\Users\USERNAME\Dropbox (Personal)\IT\jobs.csv")
'Define the TextField type and delimiter
MyReader.TextFieldType = FileIO.FieldType.Delimited
MyReader.SetDelimiters(",")
While Not MyReader.EndOfData
Dim arrCurrentRow As String() = MyReader.ReadFields()
If arrValue Is Nothing Then
ReDim Preserve arrValue(0)
arrValue(0) = arrCurrentRow(0)
Else
ReDim Preserve arrValue(arrValue.Length)
arrValue((arrValue.Length - 1)) = arrCurrentRow(0)
End If
End While
阅读文件夹列表
'check against the Clients folder
Set w = WScript.CreateObject("WScript.Shell")
w.Popup ShowFolders("C:\Users\USERNAME\Dropbox (Innovation PS)\Clients")
Function ShowFolders(folderName)
'Setting Variables
Dim fs, f, f1, fc, s
'holds folder name
s = ""
'Obtain folder Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderName)
'Obtain SubFolders collection within folder
Set fc = f.SubFolders
'Examine each item in the collection
For Each f1 in fc
s = s & f1.name
s = s & (Chr(13) & Chr(10)) ' Chr(13) & Chr(10) = Carriage return–linefeed combination
Next
ShowFolders = s
End Function
'See if it matches the .CSV file
提前谢谢你。 （如果你可以包括评论，我们将不胜感激）
答案 0 :(得分：1)
运行此脚本以获得基线，它将创建文件夹文件和属性的电子表格，然后再次将其复制到基线工作bbok并执行vlookup。您也可以使用它作为基线来创建csv并以此方式进行比较。不完全是你正在寻找但它是一个可行的解决方案
Const ForReading = 1, ForWriting = 2, Forappending = 8
'Option Explicit
'DIM Objects
'Dim variabbles
Dim folderspec
'Dim
DIM arrBlk(3)
DIM arrFLN(3)
DIM arrInfo(3)
Set objXL = Wscript.CreateObject("Excel.Application")
Set ofso = CreateObject("Scripting.FileSystemObject")
folderspec = InputBox("Please enter the path", "FileList", " ")
If folderspec = "" Then
' if cancel is selected quit the program
wscript.quit
ElseIf folderspec = " " Then
' if nothing is entered give a warning message ang quit the program
msgbox "No Directory has been seleted " & vbCrLf
wscript.quit
End If
intRow = 2
buildsheet() 'Build the XLS spreadsheet
'folderspec ="C:\_epas_5.0\Web_Server\ASP"
'folderspec ="C:\_epas_5.0\Web_Server\COM+ Source"
strFldrCmp = folderspec
Set root = ofso.GetFolder(folderspec)
ShowFileList(root)
For Each oFolder in root.subfolders
walkfolder oFolder
Next
Sub walkfolder(f)
ShowFileList(f)
For Each sf in f.subfolders
walkfolder sf
Next
End Sub
Function ShowFileList(folderspec)
Dim oFolder
Dim oFiles
Dim oFile
Set oFolder = ofso.GetFolder(folderspec)
' Wscript.echo oFolder.name
Set oFiles = oFolder.Files
' If IsEmpty(oFiles) Then Wscript.echo oFolder.name
'i = 0
For Each oFile in oFiles
i = 1 + i
'If i < 1 Then
'Wscript.echo oFolder.name,i
'End If
Next
If i < 1 Then
Wscript.echo oFolder.name & " Null"
ReDim arrB(3)
'strPath = Replace(oFolder.path,strFldrCmp,"", 1 ,1 ,vbTextCompare)
arrB(0) = "\" & Trim(oFolder.Name) 'oFolder.path
arrB(1) = ""
arrB(2) = ""
arrB(3) = ""
AddLineToXLS(arrB)
End If
For Each oFile in oFiles
ReDim arrB(3)
srtfldr = oFolder.path
' MsgBox srtfldr& " " & strFldrCmp
'strPath = Replace(srtfldr,strFldrCmp,"", 1 ,1 ,vbTextCompare)
strPath = Replace(oFolder.path,strFldrCmp,"", 1 ,1 ,vbTextCompare)
'strPath = Replace("C:\_5Test\Web_Server\ASP\app\admin","C:\_5Test\Web_Server\ASP","",,,vbTestCompare)
arrB(0) = Trim(strPath) 'oFolder.path
arrB(1) = Trim(oFile.name)
arrB(2) = Trim(oFile.Size)
arrB(3) = Trim(oFile.DateLastModified)
If LCase(ofso.GetExtensionName(oFile)) <> "scc" Then 'skip VSS .scc files
AddLineToXLS(arrB)
End If
Next
End Function
Function buildsheet
intRow = 1
objXL.Visible = True
objXL.WorkBooks.Add
'** Set Row Height
objXL.Rows(1).RowHeight = 17
'** Set Column widths
objXL.Columns(1).ColumnWidth = 40.14
objXL.Columns(2).ColumnWidth = 33.14
objXL.Columns(3).ColumnWidth = 15
objXL.Columns(4).ColumnWidth = 23
objXL.Columns(5).ColumnWidth = 23
objXL.Columns(6).ColumnWidth = 23
'** Set Cell Format for Column Titles ***
objXL.Range("A1:F1").Select
objXL.Selection.Font.Bold = True
' objXL.Selection.Font.Size = 8
objXL.Selection.Interior.ColorIndex = 15
objXL.Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.WrapText = True
objXL.Columns("A:T").Select
objXL.Columns.Font.Size = 8
objXL.Selection.HorizontalAlignment = 1 'xlCenter
objXL.Columns("C:C").Select
objXL.Selection.NumberFormat = "#,###0"
objXL.Columns("D:D").Select
objXL.Selection.NumberFormat = "m/d/yy h:mm AM/PM"
'*** Set Column Titles ***
Dim arrA(3)
arrA(0)= "File Path"
arrA(1) = "File Name"
arrA(2) = "Size(bytes)"
arrA(3) = "Modified Date/Time"
AddLineToXLS(arrA)
End Function
Function AddLineToXLS(r)' Writes a line to the spreadsheet recieves an array as input
objXL.Cells(intRow, 1).Value = r(0)
objXL.Cells(intRow, 2).Value = r(1)
objXL.Cells(intRow, 3).Value = r(2)
objXL.Cells(intRow, 4).Value = r(3)
' MsgBox r(3)
'objXL.Cells(intRow, 5).Value = r(4)
'objXL.Cells(intRow, 6).Value = r(5)
' objXL.Cells(intRow, 4).Value = r(3)
intRow = intRow + 1
objXL.Cells(1, 1).Select
End Function