Question

我正在尝试编写一个查看文件夹的简单脚本，查找指定的文件，然后在单元格上吐出时间戳。这是我已经拥有的简单部分（使用字符串和对象）。

我遇到问题的部分是在+1,000个文件的文件夹中重复超过400个特定文件。所有文件都标记不同，但有些文件可能有相似之处（AB.xls，AC.xls，AD.xls; A1.xls，A2.xls等）。我可以走很长的路，只需要冲洗并重复只是将字符串名称更改为每个特定文件，但这需要很长时间才能写入。

是否有一个快捷方式来循环这个或者我是否需要为文件名添加一个可变行来每次更改？

这是一个片段：

Sub Timecheck() 
    Dim oFS As Object 
    Dim strFilename As String 

    strFilename = "Where the file is located" 
    Set oFS = CreateObject("Scripting.FileSystemObject") 
    Sheets("tab").Activate
    ActiveSheet.Cells(3, 3).Value = oFS.GetFile(strFilename).Datelastmodified 
    Set oFS = Nothing
End Sub

Answer 1

循环浏览文件夹：

Sub timecheck()
Dim FSO As Object
Dim FLD As Object
Dim fil As Object
Dim i As Long
Dim strFolder As String
i = 1

strFolder = "C:\Your Folder Name"

'Create the filesystem object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Get a reference to the folder you want to search
Set FLD = FSO.GetFolder(strFolder)

'loop through the folder and get the file names
For Each fil In FLD.Files
    Sheets("Sheet1").Cells(i, 1) = fil.Name ' Filename in column A
    Sheets("Sheet1").Cells(i, 2) = fil.datelastmodified ' Date in column B
    i = i + 1
Next
End Sub

Answer 2

如果文件的名称在另一张纸上，则需要创建另一个将遍历该单元格范围的函数。

一旦你有了这个功能，它就会调用这个函数：

Sub Timecheck(byval aCell as object,byval X as integer,Y as integer) 
    Dim oFS As Object 
    Dim strFilename As String 
    strFilename = aCell.Text 
    Set oFS = CreateObject("Scripting.FileSystemObject") 
    Sheets("tab").Activate
    ActiveSheet.Cells(X,Y).Value = oFS.GetFile(strFilename).Datelastmodified 
    Set oFS = Nothing
End Sub

其中X和Y是您要将数据放入的单元格的坐标。您可以通过传入从另一个工作表中获取的范围中的单元格来调用它。

或者，如果您不想遍历某个范围，则将每个文件名放在新工作表的单个单元格中，并使用不会在名称中显示的字符对其进行分隔。然后取出并将其分解为文件名。

祝你好运。

编辑：

如果要迭代单元格内的分隔列表中的项目，那么一旦在对象中有单元格文本：

http://msdn.microsoft.com/en-us/library/6x627e5f(v=vs.80).aspx

输入'filename1.xls^filename2.xls^filename3.xls'

在拥有包含文件列表的单元格对象

后调用

DoStuff(cellObejct, "^")

Public Sub DoStuff( byval aCell as object, byval specialChar as string)
    Dim ListOfNames as Variant
    Dim intIndex, xCell, yCell as integer

    ListOfNames = Split(aCell.Text,specialChar)

    xCell = 1
    yCell = 1

    For intIndex = LBound(ListOfNames) To UBound(ListOfNames) 
        TimeCheck(ListOfNames(intIndex),xCell,yCell)
        yCell = yCell + 1            
    Next intIndex
End Sub

    Sub Timecheck(byval fName as string,byval X as integer,Y as integer) 
        Dim oFS As Object 
        Set oFS = CreateObject("Scripting.FileSystemObject") 
        Sheets("tab").Activate
        ActiveSheet.Cells(X,Y).Value = oFS.GetFile(fName).Datelastmodified 
        Set oFS = Nothing
    End Sub

如何在同一文件夹中的多个文件中获取特定文件的时间戳？

2 个答案: