VBA移动文件到文件夹报错Error 13类型不匹配问题求助

• 变量名调用错误：定义的文件系统对象名为fsoFSO，移动文件时错误写成fso，调用未声明对象触发类型不匹配
• 字符串拼接语法错误：移动文件的路径参数引号闭合错误、拼接符号位置错误，无效的字符串表达式触发类型错误
• 逻辑位置错误：移动文件的代码仅放在「新建文件夹」的分支内，已有文件夹的场景不会执行移动操作，不符合需求
• 可选问题：文件名没有下划线_时Split逻辑虽然不会报错，但如果要兼容无前缀文件可以加额外判断，filen变量定义为Variant属于不规范写法，改为String更合理

修复后完整代码 #

Sub loopf()
    Dim AcceptedPrefixes As Object
    Set AcceptedPrefixes = CreateObject("Scripting.Dictionary")
    
    Dim PrefixRange As Range
    Set PrefixRange = ThisWorkbook.Sheets(1).Range("B2:B368")
    
    Dim Cell As Range
    For Each Cell In PrefixRange.Cells
        If Cell <> "" And Not AcceptedPrefixes.exists(Cell.Value) Then
            AcceptedPrefixes.Add CStr(Cell.Value), 0
        End If
    Next

    Dim Directory As String
    Directory = "C:\TEST\"
    
    Dim fsoFSO As Object
    Set fsoFSO = CreateObject("Scripting.FileSystemObject")
    
    Dim filen As String
    filen = Dir(Directory)
    While filen <> ""
        Dim FilePrefix As String
        ' 兼容没有下划线的文件名，避免索引错误
        If InStr(filen, "_") > 0 Then
            FilePrefix = Split(filen, "_")(0)
        Else
            ' 没有下划线的文件可根据需求调整逻辑，此处示例直接跳过
            filen = Dir
            GoTo ContinueLoop
        End If
        
        If Not AcceptedPrefixes.exists(FilePrefix) Then
            ' 不需要删除不符合前缀的文件可注释掉下面这行
            Kill Directory & filen
        Else
            Dim TargetFolder As String
            TargetFolder = Directory & FilePrefix & "\"
            ' 文件夹不存在则创建
            If Not fsoFSO.FolderExists(TargetFolder) Then
                fsoFSO.CreateFolder TargetFolder
            End If
            ' 无论文件夹是否是新建的，都执行移动操作
            fsoFSO.MoveFile Directory & filen, TargetFolder & filen
        End If
ContinueLoop:
        filen = Dir
    Wend
    ' 释放对象
    Set fsoFSO = Nothing
    Set AcceptedPrefixes = Nothing
End Sub

关键修改点 #

• 修正了文件系统对象的调用名，统一使用fsoFSO
• 修正了路径字符串的拼接语法，统一提前定义目标路径变量，避免拼接错误
• 把移动文件的逻辑移出「新建文件夹」分支，无论文件夹是否已存在都会执行移动
• 新增了文件名下划线判断逻辑，避免无前缀文件触发Split索引错误
• 规范了变量类型声明，新增了对象释放逻辑，代码运行更稳定

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