Excel VBA Error 76：含波斯语字符路径无法找到问题求助

问题场景 #

使用VBA从文本文件提取邮箱地址时，若文件路径全为英文，代码运行正常；但路径包含波斯语字符“ی”（ChrW(1740)）和“ک”（ChrW(1705)）时，会触发Error 76：路径未找到，错误出现在Open Fname(K) For Input Access Read As #1行。

原VBA代码 #

Public Sub makeEmailList()

Fname = Application.GetOpenFilename(MultiSelect:=True)

If Not IsArray(Fname) Then MsgBox "No File Selected", vbMsgBoxRtlReading, "": Exit Sub


Dim wbkExport As Workbook
Set wbkExport = Application.Workbooks.Add

wbkExport.Worksheets(1).Cells(1, 1).Select
Selection = "EMail"

r = 1

For K = LBound(Fname) To UBound(Fname)
    If Right(Fname(K), 4) = ".txt" Then
        Open Fname(K) For Input Access Read As #1
        
        While Not EOF(1)
        
            Line Input #1, WholeLine
            If InStr(WholeLine, "@") > 0 Then
                S = InStr(WholeLine, "<th>")
                e = InStr(WholeLine, "</th>")
                r = r + 1
                wbkExport.Worksheets(1).Cells(r, "A") = Mid(WholeLine, S + 4, e - S - 4)       
            End If
        Wend
        
    End If

Next K
Close #1
End Sub

问题原因 #

VBA的Open语句对非ASCII字符处理存在缺陷，会自动将波斯语的“ی”替换为阿拉伯语的“ي”（ChrW(1610)），“ک”替换为阿拉伯语的“ك”（ChrW(1603)），导致实际路径与系统中的路径不匹配。尝试用Replace函数替换字符未生效：

Fname(K) = Replace(Replace(Fname(K), ChrW(1610), ChrW(1740)),  ChrW(1603), ChrW(1705))

已检查Windows语言区域设置及Excel语言设置，均无异常。

解决方案 #

改用FileSystemObject读取文件，它原生支持Unicode路径，能完美处理波斯语字符：

步骤1：启用Microsoft Scripting Runtime #

• 打开VBA编辑器（Alt+F11）
• 点击「工具」→「引用」，勾选Microsoft Scripting Runtime

步骤2：修改后的代码 #

Public Sub makeEmailList()
    Dim Fname As Variant
    Fname = Application.GetOpenFilename(MultiSelect:=True)
    
    If Not IsArray(Fname) Then
        MsgBox "No File Selected", vbMsgBoxRtlReading, ""
        Exit Sub
    End If
    
    Dim wbkExport As Workbook
    Set wbkExport = Application.Workbooks.Add
    wbkExport.Worksheets(1).Cells(1, 1).Value = "EMail"
    
    Dim r As Long
    r = 1
    
    ' 创建FileSystemObject实例
    Dim fso As New FileSystemObject
    Dim ts As TextStream
    Dim WholeLine As String
    
    For K = LBound(Fname) To UBound(Fname)
        If Right(Fname(K), 4) = ".txt" Then
            ' 用FileSystemObject打开文件，支持Unicode路径
            Set ts = fso.OpenTextFile(Fname(K), ForReading, False, TristateUseDefault)
            
            Do While Not ts.AtEndOfStream
                WholeLine = ts.ReadLine
                If InStr(WholeLine, "@") > 0 Then
                    Dim S As Long, e As Long
                    S = InStr(WholeLine, "<th>")
                    e = InStr(WholeLine, "</th>")
                    ' 增加判断避免索引错误
                    If S > 0 And e > S Then
                        r = r + 1
                        wbkExport.Worksheets(1).Cells(r, "A").Value = Mid(WholeLine, S + 4, e - S - 4)
                    End If
                End If
            Loop
            
            ts.Close
            Set ts = Nothing
        End If
    Next K
    
    Set fso = Nothing
    MsgBox "邮箱提取完成！", vbInformation
End Sub

代码说明 #

• FileSystemObject的OpenTextFile方法原生支持Unicode路径，不会篡改波斯语字符
• 新增S > 0 And e > S判断，避免行中无<th>/</th>标签时出现索引错误
• 移除不必要的Select操作，直接赋值单元格提升运行效率

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