如何从最新文件夹粘贴CSV数据? [英] How to paste CSV data from most recent folder?
问题描述
我们有一个模型,可以每天生成CSV格式的结果,并每次将这些文件保存在一个新文件夹中. csv文件始终具有相同的名称,只有子文件夹名称会更改(文件夹名称的一部分包含日期).
We have a model which generates daily results in CSV format and saves these files in a new folder each time. The csv files always have the same name, only the subfolder name changes (portion of the folder name contains the date).
我想创建一个vba脚本,该脚本将在所有子文件夹中搜索最新的csv文件,复制它的数据并将此数据(覆盖前几天的数据)粘贴到excel文件中.
I would like to create a vba script which would search all the subfolders for the most recent csv file, copy it's data and paste this data (overriding the previous days data) in an excel file.
我希望建立这样的东西:
I was hoping to build off something like this:
'Sub OpenLatestFile()
'Declare the variables
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
'Specify the path to the folder
MyPath = "C:\Users\Desktop\EmgMgmt"
'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Get the first Excel file from the folder
MyFile = Dir(MyPath & "*.csv", vbNormal)
'If no files were found, exit the sub
If Len(MyFile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
'Loop through each Excel file in the folder
Do While Len(MyFile) > 0
'Assign the date/time of the current file to a variable
LMD = FileDateTime(MyPath & MyFile)
'If the date/time of the current file is greater than the latest
'recorded date, assign its filename and date/time to variables
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
'Get the next Excel file from the folder
MyFile = Dir
Loop
'Open the latest file
Workbooks.Open MyPath & LatestFile
End Sub
这只会在指定的文件夹中打开最新的csv.鉴于每天都会生成一个新文件夹,因此我想编写代码以搜索所有子文件夹中的最新csv文件.我也不希望它只是打开csv而是在指定工作表中显示信息.
This just opens the most recent csv in the specified folder. Seeing as a new folder is generated daily, I would like to code to search all sub folders for the newest csv file. I also don't want it to just open the csv but psate the information in a designated sheet.
预先感谢您的帮助
推荐答案
我经常以以下方式使用ADODB
I often use ADODB to do this in the follwoing way
我为文件创建一个内存中记录集
I create a In Memory recordset for the files
Option Explicit
Function rsFiles() As ADODB.Recordset
' Defines In Memory Recordset for the files
' In Memory Recordset
' https://www.databasejournal.com/features/msaccess/article.php/3846361/Create-In-Memory-ADO-Recordsets.htm
Dim rsData As ADODB.Recordset
Set rsData = New ADODB.Recordset
rsData.Fields.Append "Filename", adVarChar, 256
rsData.Fields.Append "Extension", adVarChar, 8
rsData.Fields.Append "Path", adVarChar, 256
rsData.Fields.Append "DateCreated", adDate
rsData.Fields.Append "DateLastModified", adDate
Set rsFiles = rsData
End Function
然后我用目录结构中的所有文件填充此记录集
Then I fill this recordset with all the files in the directory structure
Sub RecursiveFolder(ByRef fld As Scripting.Folder, ByRef rsFiles As ADODB.Recordset, _
ByRef includeSubFolders As Boolean)
Dim FSO As Scripting.FileSystemObject ' Needed because I wanted the extension in a separate field
Dim sngFile As Scripting.File
Dim subFld As Scripting.Folder
'Loop through each file in the folder
Set FSO = New Scripting.FileSystemObject
For Each sngFile In fld.Files
rsFiles.AddNew
rsFiles.Fields("FileName") = sngFile.Name
rsFiles.Fields("Path") = sngFile.Path
rsFiles.Fields("Extension") = FSO.GetExtensionName(sngFile.Path & Application.PathSeparator & sngFile.Name)
rsFiles.Fields("DateCreated") = sngFile.DateCreated
rsFiles.Fields("DateLastModified") = sngFile.DateLastModified
rsFiles.Update
Next sngFile
'Loop through files in the subfolders
If includeSubFolders Then
For Each subFld In fld.SubFolders
Call RecursiveFolder(subFld, rsFiles, True)
Next subFld
End If
End Sub
这是一种使用方法
Option Explicit
' Example How to use RecursiveFolder and InMemory Recordset
' Set a reference to Microsoft Scripting Runtime and
' Micrososft Acitve Data Objects by using
' Tools > References in the Visual Basic Editor (Alt+F11)
Sub GetAFile()
Dim FSO As Scripting.FileSystemObject
Dim fld As Scripting.Folder
Dim myPath As String
Dim aFiles As ADODB.Recordset
Dim errMsg As String
On Error GoTo EH
'Specify the path to the folder
myPath = Range("A1").Value2
'Create an instance of the FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
'Make sure the folder exists
If Not FSO.FolderExists(myPath) Then
errMsg = "No such folder exists!"
GoTo EH
End If
'Get the folder
Set fld = FSO.GetFolder(myPath)
'Get the file names from the specified folder and its subfolders into an array
Set aFiles = rsFiles
aFiles.Open , , adOpenDynamic
RecursiveFolder fld, aFiles, True
' Example - Filter the recordset by Extension and sort by DateCreated
Dim sFilter As String
' Get the filter condition
sFilter = ThisWorkbook.Sheets(1).Range("A2").Value2
If Len(sFilter) > 0 Then
aFiles.Filter = "Extension Like '" & sFilter & "'"
Else
sFilter = "CSV"
aFiles.Filter = "Extension Like '" & sFilter & "'"
End If
aFiles.Sort = "DateCreated DESC"
' Print the name of the file withe the latest creation date
If aFiles.RecordCount > 0 Then
Range("A3").value2 = aFiles.Fields("Path")
Debug.Print aFiles.Fields("Path"), aFiles.Fields("Filename"), aFiles.Fields("DateLastModified")
Else
Range("A3").value2 ="No file found"
Debug.Print "No file found"
End If
ExitSub:
Exit Sub
'Error handling
EH:
If Len(errMsg) > 0 Then
MsgBox errMsg, vbExclamation
GoTo ExitSub
Else
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume ExitSub
End If
End Sub
这篇关于如何从最新文件夹粘贴CSV数据?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!