如何使用VBA获取同路径下未知名称CSV文件路径用于Excel导入

问题根因 #

你之前使用Dir(Thisworkbook.Path & "\*.csv")未生效的核心原因是：Dir函数仅返回匹配到的文件名本身，不会携带路径前缀，直接作为完整路径使用会找不到文件，同时你没有增加空值判断，当目录下无CSV文件时也会触发运行错误。

修正逻辑 #

假设你当前工作簿同路径下仅有1个CSV文件，按照如下逻辑修改代码即可：

1. 先判断工作簿是否已保存，避免ThisWorkbook.Path为空导致路径拼接错误
2. 用Dir匹配CSV文件后，需要和路径前缀拼接才是完整的文件路径
3. 增加无匹配文件的异常提示，避免静默报错

修改后的完整代码 #

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim imagePath As String
    Dim imgLeft As Double
    Dim imgTop As Double
    Dim fileName As String, folder As String
    
    ' 校验工作簿是否已保存，避免路径为空
    If ThisWorkbook.Path = "" Then
        MsgBox "请先保存当前xlsm文件再运行", vbCritical
        Exit Sub
    End If
    
    Set ws = ActiveSheet
    imagePath = ThisWorkbook.Path & "\Lamda_Logo.png"
    imgLeft = ActiveCell.Left
    imgTop = ActiveCell.Top
    
    'Width & Height = -1 means keep original size
    ws.Shapes.AddPicture _
        fileName:=imagePath, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoTrue, _
        Left:=imgLeft, _
        Top:=imgTop, _
        Width:=-1, _
        Height:=-1
    
    folder = ThisWorkbook.Path & "\"
    ' 动态获取同路径下第一个CSV文件
    fileName = Dir(folder & "*.csv")
    ' 校验是否找到CSV文件
    If fileName = "" Then
        MsgBox "未在当前工作簿目录下找到CSV文件", vbCritical
        Exit Sub
    End If
    
    ActiveCell.Offset(1, 0).Range("A12").Select
    
    With Worksheets("Sheet1").Range("A13:T13")
     .Font.Size = 12
    End With
    
    Worksheets("Sheet1").Range("A13:T13").Font.Bold = True
    Range("A13:T13").Interior.Color = RGB(147, 175, 186)
        
    With ActiveSheet.QueryTables _
        .Add(Connection:="TEXT;" & folder & fileName, Destination:=ActiveCell)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=True
    End With
    
    'check for filter, turn on if none exists
    If Not ActiveSheet.AutoFilterMode Then
        ActiveSheet.Range("A13").AutoFilter
    End If
End Sub

多CSV文件场景补充 #

如果同路径下存在多个CSV文件，你可以选择以下两种处理方式：

• 遍历所有CSV文件：多次调用Dir()函数即可依次获取所有匹配的文件名
• 弹出文件选择框让用户手动选择目标CSV文件

内容的提问来源于stack exchange，提问作者giannisJS