[英]Automatically open most recent CSV file in the folder
I am trying to program a sequence in VBA where the program will pull the most recent CSV file from a specific folder and input the query table in cell A1 on the sheet. 我正在尝试在VBA中编程一个序列,该程序将从特定文件夹中提取最新的CSV文件,并在工作表的单元格A1中输入查询表。 Right now it is only letting me pull .TXT files which I cannot seem to format into the correct table. 现在,这只是让我拉出似乎无法格式化为正确表的.TXT文件。 Any ideas? 有任何想法吗?
Thanks! 谢谢! Sub GetMostRecentFile() 子GetMostRecentFile()
Dim FileSys As FileSystemObject
Dim objFile As File
Dim myFolder
Dim strFile As String
Dim dteFile As Date
Dim Ws As Worksheet
'set path for files - change for your folder
Const myDir As String = "C:\Users\User\Desktop\Refresh Test"
'set up filesys objects
Set FileSys = New FileSystemObject
Set myFolder = FileSys.GetFolder(myDir)
'loop through each file and get date last modified. If largest date then
store Filename
dteFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
If objFile.DateLastModified > dteFile Then
dteFile = objFile.DateLastModified
strFile = objFile.Name
End If
Next objFile
Set Ws = ActiveWorkbook.Sheets("Sheet1")
With Ws.QueryTables.Add(Connection:="Text;" & strFile,
Destination:=Ws.Range("A1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
Set FileSys = Nothing
Set myFolder = Nothing
End With
End Sub
Try using the GetExtensionName
method of the file system object to test that mask is csv ie FileSys.GetExtensionName(objFile.Path) = "csv"
尝试使用文件系统对象的GetExtensionName
方法来测试掩码是否为csv,即FileSys.GetExtensionName(objFile.Path) = "csv"
For my locale (I don't know if this varies) I also had to switch these. 对于我的区域设置(我不知道这是否有所不同),我还必须切换这些设置。
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
to this 对此
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
So maybe review those settings for what you actually need. 因此,也许可以查看您实际需要的那些设置。
Code: 码:
Option Explicit
Sub GetMostRecentFile()
Dim FileSys As FileSystemObject
Dim objFile As File
Dim myFolder
Dim strFile As String
Dim dteFile As Date
Dim Ws As Worksheet
'set path for files - change for your folder
Const myDir As String = "C:\Users\User\Desktop\Refresh Test"
'set up filesys objects
Set FileSys = New FileSystemObject
Set myFolder = FileSys.GetFolder(myDir)
Dim Filename As String
'loop through each file and get date last modified. If largest date then
'store Filename
dteFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
If objFile.DateLastModified > dteFile And FileSys.GetExtensionName(objFile.Path) = "csv" Then
dteFile = objFile.DateLastModified
strFile = objFile.Name
End If
Next objFile
Set Ws = ActiveWorkbook.Sheets("Sheet1")
With Ws.QueryTables.Add(Connection:="Text;" & strFile, Destination:=Ws.Range("A1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter =True
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
Set FileSys = Nothing
Set myFolder = Nothing
End With
End Sub
Or 要么
Version 2 With command line. 版本2带命令行。 Credit to @FlorentB for solving the last part of the command string here 感谢@FlorentB解决命令字符串的最后一部分在这里
Option Explicit
Public Sub GetMostRecentFile()
Dim Ws As Worksheet, fileName As String
Const myDir As String = "C:\Users\User\Desktop\Refresh Test"
fileName = Replace$(Trim$(CreateObject("wscript.shell").exec("cmd /V /C cd " & myDir & " && (for /f ""eol=: delims="" %F in ('dir /b /od *.csv') do @set ""newest=%F"" ) && echo !newest!").StdOut.ReadAll), vbNewLine, "")
If fileName = vbNullString Then Exit Sub
Set Ws = ActiveWorkbook.Sheets("Sheet1")
With Ws.QueryTables.Add(Connection:="Text;" & (myDir & Application.PathSeparator & fileName), Destination:=Ws.Range("A1"))
.FieldNames = True
.PreserveFormatting = True
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileCommaDelimiter = True
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.