VBA使用Scripting.FileSystemObject时InStr与IF条件判断失效问题

问题根因 #

你的条件判断逻辑使用了错误的逻辑运算符：
当前你用Or连接所有Not InStr(...)判断，只要任意一个判断成立，整个If条件就会触发。比如你选中的是.pdf文件，Not InStr(xSource, ".jpg")的结果为真（文件名不含.jpg后缀），整个判断就会直接成立，触发报错。你要实现的「所有允许后缀都不存在才触发报错」的逻辑，应该用And连接所有判断。

修复方案 #

方案1：直接修改逻辑运算符 #

把所有Or替换为And即可正常运行：

xSource = vrtSelectedItem  '<<== C:\Users\Me\Desktop\Document01.pdf

Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
    
If Not InStr(xSource, ".jpg") And Not InStr(xSource, ".bmp") And Not InStr(xSource, ".png") _
And Not InStr(xSource, ".tif") And Not InStr(xSource, ".tga") And Not InStr(xSource, ".jpeg") _
And Not InStr(xSource, ".doc") And Not InStr(xSource, ".pdf") And Not InStr(xSource, ".rtf") _
And Not InStr(xSource, ".htm") And Not InStr(xSource, ".html") And Not InStr(xSource, ".txt") _
And Not InStr(xSource, ".docx") And Not InStr(xSource, ".tdm") And Not InStr(xSource, ".wri") _
And Not InStr(xSource, ".xls") And Not InStr(xSource, ".xlsx") And Not InStr(xSource, ".xlsm") _
And Not InStr(xSource, ".ods") And Not InStr(xSource, ".odt") Then

MsgBox "File type not allowed"
Exit Sub

Else
' 你的原有后续逻辑
End If

方案2：更易维护的优化写法 #

推荐用数组存储允许的后缀，遍历判断，后续新增允许后缀直接修改数组即可，同时避免大小写不匹配、文件名中间含后缀字符的误判问题：

xSource = vrtSelectedItem
Set FSO = VBA.CreateObject("Scripting.FileSystemObject")

' 提取文件后缀并统一转小写
Dim fileExt As String
fileExt = LCase(FSO.GetExtensionName(xSource))

' 允许的后缀列表
Dim allowedExts As Variant
allowedExts = Array("jpg", "bmp", "png", "tif", "tga", "jpeg", _
                    "doc", "pdf", "rtf", "htm", "html", "txt", _
                    "docx", "tdm", "wri", "xls", "xlsx", "xlsm", _
                    "ods", "odt")

Dim ext As Variant, isAllowed As Boolean
isAllowed = False
For Each ext In allowedExts
    If ext = fileExt Then
        isAllowed = True
        Exit For
    End If
Next

If Not isAllowed Then
    MsgBox "File type not allowed"
    Exit Sub
End If

' 你的原有后续逻辑

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