Excel VBA加载文件夹后无法显示.log文件问题求助

核心问题分析 #

1. 你使用的GetFolderName调用的文件夹选择对话框，默认仅展示文件夹层级，不会显示其中的.log文件，导致无法直观确认目标文件；
2. 代码中文件名处理逻辑存在错误：Dir返回的fileName仅为纯文件名（不含路径），InStrRev(fileName, "\\")会返回0，导致sFullFilename的计算完全无意义。

修复方案 #

方案1：改用文件选择对话框（直接可视化选择.log文件） #

替换原有的文件夹选择逻辑，使用支持文件预览的对话框，让你能直接看到并选择目标.log文件：

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd
    .Title = "选择要导入的.log文件"
    .Filters.Clear
    .Filters.Add "日志文件", "*.log" ' 仅显示.log类型文件
    .AllowMultiSelect = True ' 支持多选文件
    
    If .Show = -1 Then
        ' 遍历所有选中的文件
        Dim selectedFile As Variant
        For Each selectedFile In .SelectedItems
            fileName = Mid(selectedFile, InStrRev(selectedFile, "\") + 1)
            textFileLocation = Left(selectedFile, InStrRev(selectedFile, "\"))
            fileDate = Format(FileDateTime(selectedFile), "mm/dd/yyyy")
            
            ' 修复文件名提取逻辑
            sFileName = Left(fileName, InStr(fileName, ".") - 1)
            
            ' 保留原有的文件内容导入逻辑
            arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(selectedFile, 1).ReadAll, vbCrLf)
            lastR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
            ws.Range("A" & IIf(lastR = 1, lastR, lastR + 1)).Resize(UBound(arrTxt) + 1, 1).Value = Application.Transpose(arrTxt)
            ws.Columns(1).TextToColumns Destination:=ws.Range("A1"), DataType:=xlFixedWidth, _
                FieldInfo:=Array(Array(0, 1), Array(43, 1), Array(70, 1)), TrailingMinusNumbers:=True
        Next selectedFile
    End If
End With

方案2：保留文件夹选择，添加文件列表确认环节 #

如果坚持使用文件夹选择模式，可在选中文件夹后，在Excel中列出所有.log文件供你确认后再执行导入：

textFileLocation = GetFolderName("C:\Users\Documents\Log")

' 在Sheet2的A列生成待导入文件列表（可自行修改工作表和显示区域）
Dim wsList As Worksheet
Set wsList = ThisWorkbook.Sheets("Sheet2")
wsList.Cells.Clear
wsList.Range("A1").Value = "待导入的.log文件列表"

fileName = Dir(textFileLocation & "\*.log")
Dim rowNum As Integer
rowNum = 2
Do While fileName <> ""
    wsList.Range("A" & rowNum).Value = fileName
    rowNum = rowNum + 1
    fileName = Dir() ' 获取下一个文件
Loop

' 确认后执行导入
If MsgBox("确认导入以上" & rowNum - 2 & "个文件？", vbYesNo) = vbYes Then
    fileName = Dir(textFileLocation & "\*.log") ' 重置Dir指针
    Do While fileName <> ""
        ' 修复文件名提取逻辑
        sFileName = Left(fileName, InStr(fileName, ".") - 1)
        
        ' 保留原有的文件内容导入逻辑
        arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(textFileLocation & "\" & fileName, 1).ReadAll, vbCrLf)
        lastR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        ws.Range("A" & IIf(lastR = 1, lastR, lastR + 1)).Resize(UBound(arrTxt) + 1, 1).Value = Application.Transpose(arrTxt)
        ws.Columns(1).TextToColumns Destination:=ws.Range("A1"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 1), Array(43, 1), Array(70, 1)), TrailingMinusNumbers:=True
            
        fileName = Dir()
    Loop
End If

单独修复：文件名处理逻辑 #

原代码中sFullFilename的计算完全无效，直接替换为以下正确的文件名提取逻辑即可：

sFileName = Left(fileName, InStr(fileName, ".") - 1)

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