自动打开文件夹中最新的 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 解决了命令字符串的最后一部分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