#2
厨师王德榜2022-06-10 14:05
|
出错代码: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
只有本站会员才能查看附件,请 登录