用excel vba计算文件夹中的特定文件
我需要一些帮助，我的Excel VBA。
首先让我告诉它应该做什么…
在networking文件夹中有应该被计数的pdf文件。 文件夹看起来像这样：
X:/Tests/Manufact/Prod_1/Machine/Num/Year/Month/TEST_DDMMYYYY_TIMESTAMP.PDF X:/Tests/Manufact/Prod_2/Machine/Num/Year/Month/TEST_DDMMYYYY_TIMESTAMP.PDF X:/Tests/Manufact/Prod_3/Machine/Num/Year/Month/TEST_DDMMYYYY_TIMESTAMP.PDF 还有一个每年和每个月的文件夹，其中的pdf是根据其创builddatesorting。 计数的文件应作为列表的文件名和date在活动工作表中列出。 之后，我想统计在特定时间之间在特定时间内创build了多less个pdf文件。 应该在新的工作表中
Date - Time-Period 1 (0AM-6AM) - Time Period 2 (6AM-10AM) - Time Period 3 (10AM - 12AM) 01.01.2017 - 12PDFs - 17PDFs - 11PDFs 02.01.2017 - 19PDFs - 21PDFs - 5PDFs
也许还有一种内存方式，所以脚本不会重新计算之前已经列出的所有文件？ （因为有超过10万PDF，每天都在增加…）
所以…我在互联网上search了整整一周的解决scheme，并且发现了一些，结束了我的代码：
Sub ListFiles() Const sRoot As String = "X:\Tests\Manufact\" Dim t As Date Application.ScreenUpdating = False With Columns("A:E") .ClearContents .Rows(1).Value = Split("File,Date,Day,Time,Size", ",") End With t = Timer NoCursing sRoot Columns.AutoFit Application.ScreenUpdating = True MsgBox Format(Timer - t, "0.0s") End Sub Sub NoCursing(ByVal sPath As String) Const iAttr As Long = vbNormal + vbReadOnly + _ vbHidden + vbSystem + _ vbDirectory Dim col As Collection Dim iRow As Long Dim jAttr As Long Dim sFile As String Dim sName As String If Right(sPath, 1) <> "\" Then sPath = sPath & "\" Set col = New Collection col.Add sPath iRow = 1 Do While col.count sPath = col(1) sFile = Dir(sPath, iAttr) Do While Len(sFile) sName = sPath & sFile On Error Resume Next jAttr = GetAttr(sName) If Err.Number Then Debug.Print sName Err.Clear Else If jAttr And vbDirectory Then If Right(sName, 1) <> "." Then col.Add sName & "\" Else iRow = iRow + 1 If (iRow And &HFFF) = 0 Then Debug.Print iRow Rows(iRow).Range("A1:E1").Value = Array(sName, _ FileDateTime(sName), _ FileDateTime(sName), _ FileDateTime(sName), _ FileLen(sName)) End If End If sFile = Dir() Loop col.Remove 1 Loop End Sub
它所做的是计算导演中的所有文件（所以有些东西缺less告诉它只计算PDF文件）。
它列出了我的工作表中的文件，我很高兴与该部分，但它只列出它。 我仍然需要sorting部分，所以要么只是计算date和时间段，要么先计算/列出所有事情，然后再从列表中sorting和计算date和时间段（我真的不知道哪一个会做的更好，也许有一个简单的方法和一个困难的？）
所以，如果有任何人有线索如何做到这一点，请让我知道，我感谢任何帮助！
最好的问候 – 1月
好的，我刚刚在一个类似的项目上工作。 我会在这里假设一些事情，你告诉我是否有什么会打破整个系统。
1）我们可以并且被允许在处理之后将.PDF文件移动到一个子文件夹，或者2）我们可以并且可以重命名（甚至临时）.PDF文件。
3）如果我们通过一个月，我们不需要处理它，例如今天我们在2017年2月，所以我们停止处理2017年1月的文件。
如果我们可以并且被允许继续这些假设，那么为了减less双重工作，一旦.PDF被处理，它可以被移动到在该月份的文件夹中被称为Processed Files的子文件夹中，并且在月末可以返回它们，或者通过附加一个特殊的标签（如果该string永远不会出现在文件名中）来重新命名“PrOCed”，然后我们可以排除该文件夹中的任何文件或该标签。
我build议你只是把所有的文件名读入工作表中，然后使用Text-to-Columns来获得文件创build的date和时间，另外也许你可以使用FileSystemObject来获取信息，然后使用Excel组function按天和小时分解。
希望这有助于，如果你需要任何代码示例，让我知道。
这是我将如何做到这一点。 以下内容大部分未经testing，应该被视为伪代码。 除此之外，我还不清楚是否可以给出一个明确的答案，因为我必须做出太多的假设（例如，在“Num”目录中是Num，或者是一个数字，TIMESTAMP是如何定义的等等）。
我假设你的pdf将被正确归档在正确的月份文件夹中。 也就是说，例如，你将不会在'10'文件夹中说'09'（这将是一个错误条件）。 如果是这种情况，那么我build议应该工作。 请注意，我也假设文件名是正确的。 如果没有，你可以添加额外的error handling。 现在，如果我在文件名中发现一个错误，我只是略过它 – 但你可能想打印出来，如代码注释中提到的。
主要的数据结构是一个字典，一旦该月的所有pdf已经被处理，该字典最终应该在每个月的每一天都有一天的input（即密钥，值）。 这个字典的关键是一个2位数的string，表示从“01”到“31”（有31天的月份）的那一天。 该值是一个长度为3的1维数组。因此，一个典型的条目可以是（20,31,10），其是期间1的20个文件，期间2的31和期间3的10。
对于每个文件，您只处理一个仅提取date和小时的正则expression式。 我假设时间段不重叠（只是让事情更容易 – 即，所以我不必打扰分钟）。 一旦提取出来，然后根据我find的小时，将这个天数添加到正确的时间段。
你应该注意到，我假设如果你已经通过了一个月的所有产品目录，你现在已经有了那么多个月的文件。 因此，使用所有月份文件，您现在可以在每天的不同工作表上打印期间计数。
我没有执行'SummarizeFilesForMonth'的困扰，但这应该是相对简单的，一切都已经被debugging。 在这个地方你可以按照正确的顺序遍历date键来打印出周期的统计信息。 除此之外，不应该有任何其他的sorting。
Option Explicit ' Gets all files with the required file extension, ' strips off both the path and the extension and ' returns all files as a collection (which might not be ' what you want - ie might want the full path on the 1st sheet) Function GetFilesWithExt(path As String, fileExt As String) As Collection Dim coll As New Collection Dim file As Variant file = dir(path) Dim fileStem As String, ext As String Do While (file <> "") ext = Right(file, Len(file) - InStrRev(file, ".")) If ext = fileExt Then fileStem = Right(file, Len(file) - InStrRev(file, "\")) coll.Add Left(fileStem, Len(file) - 5) End If file = dir Loop Set GetFilesWithExt = coll End Function ' Checks whether a directory exists or not Function pathExists(path As String) If Len(dir(path, vbDirectory)) = 0 Then pathExists = False Else pathExists = True End If End Function ' TEST_DDMMYYYY_TIMESTAMP is the filename being processed ' assuming TIMESTAMP is hr min sec all concatenated with ' no intervening spaces and all are always 2 digits Sub UpdateDictWithDayFile(ByRef dictForMonth As Variant, file As String) Dim regEx As New RegExp ' only extracts day and hour - you'll almost certainly ' have to adjust this regular expression to suit your needs Dim mat As Object Dim Day As String Dim Hour As Integer regEx.Pattern = "TEST_(\d{2})\d{2}\d{4}_(\d{2})\d{2}\d{2}$" Set mat = regEx.Execute(file) If mat.Count = 1 Then Day = mat(0).SubMatches(0) ' day is a string Hour = CInt(mat(0).SubMatches(1)) ' hour is an integer Else ' Think about reporting an error here using debug.print ' ie, the filename isn't in the proper format ' and will not be counted Exit Sub End If If Not dictForMonth.exists(Day) Then ' 1 dimensional array of 3 items; one for each time period dictForMonth(Day) = Array(0, 0, 0) End If Dim periods() As Variant periods = dictForMonth(Day) ' I'm using unoverlapping hours unlike what's given in your question Select Case Day Case Hour <= 6 periods(0) = periods(0) + 1 Case Hour >= 7 And Hour < 10 periods(1) = periods(1) + 1 Case Hour >= 10 periods(2) = periods(2) + 1 Case Else ' Another possible error; report on debug.print ' will not be counted Exit Sub End Select End Sub Sub SummarizeFilesForMonth(ByRef dictForMonth As Variant) ' This is where you write out the counts ' to the new sheet for the month. Iterate through each ' day of the month in 'dictForMonth' and print ' out each of pdf counts for the individual periods ' stored in the 1 dimensional array of length 3 End Sub Sub ProcessAllFiles() ' For each day of the month for which there are pdfs ' this dictionary will hold a 1 dimensional array of size 3 ' for each Dim dictForMonth As Object Dim year As Integer, startYear As Integer, endYear As Integer Dim month As Integer, startMonth As Integer, endMonth As Integer Dim prodNum As Integer, startProdNum As Integer, endProdNum As Integer Dim file As Variant Dim files As Collection startYear = 2014 startMonth = 1 endYear = 2017 endMonth = 2 startProdNum = 1 endProdNum = 3 Dim pathstem As String, path As String pathstem = "D:\Tests\Manufact\Prod_" Dim ws As Worksheet Dim row As Integer Set ws = ThisWorkbook.Sheets("Sheet1") row = 1 For year = startYear To endYear: For month = 1 To 12: Set dictForMonth = CreateObject("Scripting.Dictionary") For prodNum = startProdNum To endProdNum If prodNum = endProdNum And year = endYear And month > endMonth Then Exit Sub path = pathstem & prodNum & "\Machine\Num\" & year & "\" & Format(month, "00") & "\" If pathExists(path) Then Set files = GetFilesWithExt(path, "pdf") For Each file In files: ' Print out file to column 'A' of 'Sheet1' ws.Cells(row, 1).Value = file row = row + 1 UpdateDictWithDayFile dictForMonth, CStr(file) Next End If Next prodNum SummarizeFilesForMonth dictForMonth Next month Next year End Sub
好的，谢谢你确认的限制
那么下一个选项就是在工作表中build立一个已经处理过的文件名列表并传递它们，例如，如果你使用For Each循环遍历文件，将会有一个testing来查看当前该文件的名称在处理文件的列表中，跳过它，否则处理它并将其名称添加到列表中。
3是指上个月的所有文件。 这样我们可以按datesearch文件并获取新文件进行处理。 因此，在特定date（上次运行date）之后生成的所有文件将被视为新的并且需要被处理。
这会工作吗？