VBA从excel列表中自动添加word中的自动更正项

Sub AddAutoCorrectToWord()
    Dim excelApp As Object
    Dim excelWorkbook As Object
    Dim excelWorksheet As Object
    Dim wordApp As Object
    Dim wordDocument As Object
    Dim i As Long
    
    ' 创建Excel对象
    Set excelApp = CreateObject("Excel.Application")
    excelApp.Visible = True
    
    ' 打开Excel文件
    Set excelWorkbook = excelApp.Workbooks.Open("Excel文件路径")
    
    ' 选择Excel中的工作表
    Set excelWorksheet = excelWorkbook.Worksheets("工作表名称")
    
    ' 创建Word对象
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = True
    
    ' 创建新的Word文档
    Set wordDocument = wordApp.Documents.Add
    
    ' 循环遍历Excel列表中的每一行
    For i = 1 To excelWorksheet.UsedRange.Rows.Count
        ' 获取Excel列表中的自动更正项
        Dim autoCorrectEntry As String
        autoCorrectEntry = excelWorksheet.Cells(i, 1).Value
        
        ' 将自动更正项添加到Word的自动更正列表中
        wordApp.AutoCorrect.Entries.Add autoCorrectEntry, autoCorrectEntry
        
        ' 在Word文档中插入自动更正项
        wordDocument.Content.InsertAfter autoCorrectEntry & vbCrLf
    Next i
    
    ' 保存并关闭Excel和Word对象
    excelWorkbook.Close SaveChanges:=False
    excelApp.Quit
    wordDocument.SaveAs "Word文件路径"
    wordDocument.Close
    wordApp.Quit
    
    ' 释放对象变量
    Set excelWorksheet = Nothing
    Set excelWorkbook = Nothing
    Set excelApp = Nothing
    Set wordDocument = Nothing
    Set wordApp = Nothing
End Sub