繁体   English   中英

vba遍历文件夹中的新文件

[英]vba loop through new files in folder

我有一个文件夹,其中下载了FTP服务器上的CSV文件,我需要打开最新文件并从中提取数据。 我这样做与从文本连接获取数据有效。 问题是该文件夹中有15000多个文件,我只需要打开上周的文件,也许是100个文件。 有没有办法按一定顺序打开它们? 那么我可以说时间戳文件<然后是一段时间->停止循环。

谢谢!

希望这可以帮助。 这是我的改造项目。 重要的是,将要从中过滤文件的日期写入到cell(5,1)。 例如,如果您放置2015年11月11日,则只会显示比该文件小的文件,因此不会记录任何文件。 但是,如果将1.1.1914放在单元格5,1中,则将弹出所有文件。 我不知道您打开哪个文件。 您没有含义类型,所以我没有将workbook.open放入代码中,但是我在代码中加了条注释,应该进行一些打开。 因此,根据您的需要编辑我的代码。

Private Sub CommandButton1_Click()
ThisWorkbook.Save
DoEvents
Const ROW_FIRST As Integer = 2
Dim intResult As Integer
Dim strPath As String
Dim objFSO As Object
Dim intCountRows As Integer

Application.FileDialog(msoFileDialogFolderPicker).Title = "Vyberte prosím složku"
Application.FileDialog(msoFileDialogFolderPicker).ButtonName = "Vybrat složku"
Application.FileDialog(msoFileDialogFolderPicker).AllowMultiSelect = True

intResult = Application.FileDialog(msoFileDialogFolderPicker).Show

For Each Item In Application.FileDialog(msoFileDialogFolderPicker).SelectedItems
    If intResult <> 0 Then
        Application.ScreenUpdating = False
        Range("A:A").ClearContents
        Range("B:B").ClearContents
        Range("C:C").ClearContents
        Cells(1, 1).Value = "NAME"
        Cells(1, 2).Value = "PATH"
        Cells(1, 3).Value = "TAIL"
        Cells(1, 4).Value = "Last check:"

        strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)

        Set objFSO = CreateObject("Scripting.FileSystemObject")

        intCountRows = GetAllFiles(strPath, ROW_FIRST, objFSO)
        Call GetAllFolders(strPath, objFSO, intCountRows)
        Application.ScreenUpdating = True
    End If
Next Item
Cells(1, 5).Value = Date
End Sub

Private Function GetAllFiles(ByVal strPath As String, ByVal intRow As Integer, ByRef objFSO As Object) As Integer
DoEvents
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
i = intRow - ROW_FIRST + 1
Set objFolder = objFSO.GetFolder(strPath)

For Each objFile In objFolder.Files
    inte = InStr(1, objFile.Name, "prázdný")
        If objFile.datecreated > DateValue(Cells(1, 5).Value) Then
'HERE SHOULD BE THE OPENING PROCEDURE!!!!!!!!!!!!!!                
                Cells(i + ROW_FIRST - 1, 1) = objFile.Name
                Cells(i + ROW_FIRST - 1, 2) = objFile.Path
                Cells(i + ROW_FIRST - 1, 3) = Right(objFile.Name, Len(objFile.Name) - InStrRev(objFile.Name, "."))
                i = i + 1
        End If
Next objFile
GetAllFiles = i + ROW_FIRST - 1

End Function

Private Sub GetAllFolders(ByVal strFolder As String, ByRef objFSO As Object, ByRef intRow As Integer)
DoEvents
Dim objFolder As Object
Dim objSubFolder As Object
Static veSpravneSlozce As Boolean

Set objFolder = objFSO.GetFolder(strFolder)
For Each objSubFolder In objFolder.subfolders
        intRow = GetAllFiles(objSubFolder.Path, intRow, objFSO)
        Call GetAllFolders(objSubFolder.Path, objFSO, intRow)
Next objSubFolder
End Sub

打开过程应该在中间子

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM