我的excel vba需要一些帮助。
首先让我告诉它应该做些什么...
在网络文件夹中有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根据其创建日期进行排序。 计算的文件应作为包含文件名和日期的列表在活动表中列出。 之后，我想计算在给定时间内特定日期创建的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文件，而且每天都在增加...）
所以...我在互联网上搜索了整整一个星期的解决方案，我找到了一些，最后得到了这段代码：
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
它的作用是计算directorys中的所有文件（因此有些东西缺少告诉它只计算PDF）。
它确实列出了我的工作表中的文件，我对该部分感到满意，但它只列出了它。我仍然需要排序部分，所以要么只让它计算日期和时间段，要么让它先计算/列出所有内容，然后再排序和计算列表中的日期和时间段（我真的不知道哪个一个会更好，也许有一个简单的方法和一个艰难的方式？）
所以，如果有人知道如何做到这一点，请告诉我，我感谢任何帮助！
最诚挚的问候 - Jan
答案 0 :(得分：0)
好吧我不久前刚刚参与了一个类似的项目。我将在这里假设一些事情，你告诉我是否会破坏整个系统。
1）我们可以并且可以在处理之后将.PDF文件移动到子文件夹，或者 2）我们可以并且被允许重命名（甚至是临时的）.PDF文件。
3）如果我们通过一个月，我们不再需要处理它，例如今天我们在2017年2月，所以我们停止处理2017年1月的文件。
如果我们可以并且被允许继续这些假设，那么为了减少双重工作，一旦处理完.PDF，它就可以被移动到该月份文件夹中名为Processed Files的子文件夹，并且在结束时我们可以将它们返回，或者通过附加特殊标签重命名的月份，如果该字符串永远不会出现在文件名中，则说“PrOCed”，然后我们可以排除该新文件夹中的所有文件或使用该标签。< / p>
我建议您只需将所有文件名读入工作表，然后使用Text-to-Columns获取文件创建的日期和时间，另外也许您可以使用FileSystemObject获取该信息，然后只需使用Excel Group功能按日和小时分类。
希望这有帮助，如果您需要任何代码示例，请告诉我。
答案 1 :(得分：0)
这是我将如何做到的。以下几点未经测试 并且应该被视为伪代码。除此之外不是 很清楚，我可以给出一个明确的答案，因为我必须做出来 很多假设（即目录中的Num只是'Num'或者是 它是一个数字，如何定义TIMESTAMP等。
我假设您的pdf将正确归档于 正确的月份文件夹 即，例如，你不会有 在'10'文件夹中说一个月'09'（这将是一个错误条件）。如果是这样的话 我提出的建议应该有效。请注意，我也是假设 文件名是正确的。如果没有，您可以添加其他错误 处理。现在，如果我在文件名中发现错误，我只是跳过它 - 但是 你可能想要把它打印出去 代码评论。
主数据结构是一个应该最终拥有的字典 所有pdf为该月的每一天的一天条目（即密钥，值） 已经处理了一个月。这本词典的关键是2位数 字符串，代表从'01'到'31'的那一天（对于那个月 有31天）。该值是长度为3的1维数组。因此是典型的 条目可以是（20,31,10），这是第1期的20个文件，第2期和第31期的31 10期为第3期。
对于每个文件，您处理一个仅提取日期和小时的正则表达式。 我假设时间段不重叠（只是让事情更容易 - 即如此 我不必费心分钟）。一旦提取了我然后添加 那天根据我找到的小时数组了正确的时间段。
你应该注意我假设你已经浏览了所有产品目录 对于给定月份，您现在拥有所有月份文件。整个月都是如此 您现在可以在不同的工作表上打印出周期计数的文件 一天。
我没有打扰实现'SummarizeFilesForMonth'，但这应该是 其他一切都经过调试后相对简单。这是 您将以正确的顺序遍历日期键的地方 打印出期间统计数据。除此之外，不应该有任何 其他额外的排序。
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
' i.e., 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
答案 2 :(得分：0)
好的，感谢您确认限制Jan
那么下一个选项是在工作表中构建一个已经处理并传递它们的文件名列表，例如，如果你使用For Each循环来遍历文件，那么将会有一个测试看到如果文件的当前名称在已处理文件列表中，则跳过它，否则处理它并将其名称添加到列表中。
这会起作用吗？