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

Question

我正在尝试在VBA中编写一个序列，程序将从特定文件夹中提取最新的CSV文件，并在工作表的单元格A1中输入查询表。现在它只是让我拉.TXT文件，我似乎无法格式化到正确的表。有任何想法吗？

谢谢！     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)


'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

Answer 1

尝试使用文件系统对象的GetExtensionName方法来测试该掩码是csv，即FileSys.GetExtensionName(objFile.Path) = "csv"

对于我的语言环境（我不知道这是否有所不同）我还必须切换它们。

.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False

到这个

.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True

因此，可以根据实际需要查看这些设置。

代码：

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

或

版本2使用命令行。感谢@FlorentB解决命令字符串here

的最后部分

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