注册 登录
编程论坛 Excel/VBA论坛

新手求助:Excel VBA 导出 Word 出错

wjs9 发布于 2022-05-25 21:06, 683 次点击
提示如图。
出错代码:ChangeFileOpenDirectory
系统:Win7旗舰版64位,Office2016 64位。

网上找的原代码:
Sub XM()
    ' 打开 調査報告-1.xlsx 文件
    Dim MyFile As Object
    Set MyFile = CreateObject("Scripting.FileSystemObject")
   
    Dim FilePath As String
    FilePath = ActiveDocument.Path & "\調査報告-1.xlsx"
   
    ' 如果不存在 調査報告-1.xlsx 文件
    If Not MyFile.FileExists(FilePath) = False Then
        ' 退出
        MsgBox "无法找到文件: 調査報告-1.xlsx", Title:="Error"
        Exit Sub
    End If
   
    ' 读取 調査報告-1.xlsx 文件
    Dim ExcelObject As Object
    Set ExcelObject = GetObject(FilePath)
    Set Table = ExcelObject.Sheets(1).UsedRange()

' 循环
    For i = 2 To Table.Rows.Count
        ' 清空变量
        For Each Var In ActiveDocument.Variables
            Var.Delete
        Next
        
        ' 添加一个名字为 住所 的变量,它的值是 調査報告-1.xlsx 中第 i 行第 5 列的内容
        ActiveDocument.Variables.Add Name:="住所", Value:=Table.Cells(i, 5).Text
        
        ' 更新 Word 文档
        ActiveDocument.Fields.Update
        
        ' 设置保存目录
        ChangeFileOpenDirectory ActiveDocument.Path
        ChangeFileOpenDirectory "G:\E-VBA\Documents"
        Documents.Open Filename:="住所.doc"

        ' 保存文件,文件名为:住所.docx
        ActiveDocument.SaveAs2 Filename:=Table.Cells(i, 5).Text & ".docx", FileFormat:= _
            wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
            :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
            :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
            SaveAsAOCELetter:=False, CompatibilityMode:=15
    Next
End Sub
只有本站会员才能查看附件,请 登录
1 回复
#2
厨师王德榜2022-06-10 14:05
这段 代码你是粘贴在excel中还是粘贴在word中 运行的 ?
其次 ,If not MyFile.FileExists(FilePath) = False Then 这句你自己琢磨琢磨,这个not 是不是多余?
最后 ,在 Next 这句前,加一句  ActiveDocument.Close 更合理.
   

[此贴子已经被作者于2022-6-10 14:21编辑过]

1