简体   繁体   English

自动打开文件夹中的最新CSV文件

[英]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.

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