列出文件创建日期与周号不匹配的目录中的所有文件? VBA

时间:2016-12-16 10:53:20

标签: excel vba

我正在尝试列出目录中创建日期的文件是否在该日期的匹配周数下的所有文件?

例如:

在单元格H7中,我有第50周。

在我的目录中,我有以下文件:

A.pdf - Created 15/12/2016
B.pdf - Created 15/12/2016
C.pdf - Created 01/12/2016

只应列出12月15日创建的文件,因为这些文件属于第50周。出于某种原因,我的代码什么都不做,并且没有列出文件或产生错误。

Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
If Dir("G:\STOCK\(3) Promotions\Allocations\" & Range("N7").Value & "\" & Range("B7").Value & "\WK " & Range("H7").Value & "\" & client, vbDirectory) <> "" Then


Set objFolder = objFSO.GetFolder("G:\STOCK\(3) Promotions\Allocations\" & Range("N7").Value & "\" & Range("B7").Value & "\WK " & Range("H7").Value & "\")


i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
If Application.WeekNum(objFile.DateCreated) Like Range("H7").Value Then


'print file PG
    Cells(i + 12, 1) = Range("N7").Value
    'print file Month
    Cells(i + 12, 5) = Range("H7").Value

    'print file Year
    Cells(i + 12, 9) = Range("B7").Value

    'print file name
    Cells(i + 12, 13) = objFile.Name

    'print file path
    Cells(i + 12, 18) = "=hyperlink(""" & objFile.Path & """)"

    i = i + 1
    End If
Next objFile

Else

MsgBox "No Results Were Found."
End If
End Sub

请有人告诉我我哪里出错了吗?

1 个答案:

答案 0 :(得分:0)

很可能你使用的是ISO会议的周年纪念,其中第1周是一年中的第一周,包含4天,周数从星期一开始。

因此,您希望将Application.Weeknumber比较行替换为:

If DatePart("ww", objFile.DateCreated, vbMonday, vbFirstFourDays) = ...

如果您使用不同的约定来计算Weeknumber,您应该能够将它合并到DatePart参数中。