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

Question

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

谢谢！ 子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解决命令字符串的最后一部分在这里

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