如何在Word计数VBA宏中添加文件名输出至Excel单元格A2

你的修改代码存在两个核心问题：

• 重复触发文件选择对话框：新增的filename = Application.GetOpenFilename会让用户再次选择文件，完全没必要，因为之前已经通过strPath获取了选中文件的路径
• 对象赋值错误：cell = Application.Range("A2")没有用Set关键字，Range是对象类型，必须用Set赋值，否则会抛出运行时错误'91'

以下是修正后的完整代码：

Public Sub word_count()
    
    Dim objWord As Object, objDocument As Object
    Dim strText As String
    Dim lngIndex As Long
    Dim intChoice As Integer
    Dim strPath As String
    Dim fileName As String ' 变量名首字母大写避免和内置函数冲突
    
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = False
    
    ' 仅调用一次文件对话框，同时处理用户取消选择的情况
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        If .Show = -1 Then ' 用户点击确定按钮
            strPath = .SelectedItems(1)
        Else
            ' 用户取消选择，直接退出宏
            objWord.Quit
            Set objDocument = Nothing
            Set objWord = Nothing
            Exit Sub
        End If
    End With
    
    Set objDocument = objWord.documents.Open(strPath)
    strText = objDocument.Content.Text
    objDocument.Close SaveChanges:=False
    
    ' 清理文本中的特殊字符和多余空格
    For lngIndex = 0 To 31
        strText = Replace(strText, Chr$(lngIndex), Space$(1))
    Next
    
    Do While CBool(InStr(1, strText, Space$(2)))
        strText = Replace(strText, Space$(2), Space$(1))
    Loop
    
    ' 输出词数和文件名到指定单元格
    With Sheets("calc tool")
        .Range("A1").Value = UBound(Split(strText, Space$(1)))
        ' 从完整路径中提取纯文件名
        fileName = Dir(strPath)
        .Range("A2").Value = fileName
    End With
    
    objWord.Quit
    
    Set objDocument = Nothing
    Set objWord = Nothing
    
End Sub

关键修改说明 #

1. 用With语句简化文件对话框调用，同时增加用户取消选择的判断，避免无意义的后续执行
2. 去掉冗余的二次文件选择操作，直接通过Dir(strPath)从已获取的完整路径中提取文件名（比如输入C:\Docs\report.docx会返回report.docx）
3. 简化单元格赋值逻辑，通过With Sheets("calc tool")避免重复切换工作表，减少出错概率
4. 调整变量名避免与VBA内置函数冲突，提升代码规范性

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