WORD执行宏分页时报错，报错位置为Set mybook = ExcelApp.Workbooks.Open(lujing)

xumingyuDD

Sub 分页单独存为文件()
'
' 分页单独存为文件 宏
'
    Dim oSrcDoc As Document, oNewDoc As Document
    Dim strSrcName As String, strNewName As String, Str_coon As String, StrSQL As String, DirArr As String
    Dim oRange As Range
    Dim nIndex As Integer, nSubIndex As Integer, nTotalPages As Integer, nBound As Integer
    Dim fso As Object
   
    Const nSteps = 1         ' 修改这里控制每隔几页分割一次
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oSrcDoc = ActiveDocument
    Set oRange = oSrcDoc.Content
   
    FileName = InputBox("请输入邮件列表名称")
    lujing = "D:\1\" & FileName & ".xls"
    Set ExcelApp = CreateObject("Excel.Application")
    Set mybook = ExcelApp.Workbooks.Open(lujing)
    mybook.Activate
    Set mysheet = mybook.Worksheets("Sheet1")

   
    nTotalPages = ActiveDocument.Content.Information(wdNumberOfPagesInDocument)
    oRange.Collapse wdCollapseStart
    oRange.Select
      
    For nIndex = 1 To nTotalPages Step nSteps
        Set oNewDoc = Documents.Add
        If nIndex + nSteps > nTotalPages Then
            nBound = nTotalPages
        Else
            nBound = nIndex + nSteps - 1
        End If
        For nSubIndex = nIndex To nBound
            oSrcDoc.Activate
            oSrcDoc.Bookmarks("\page").Range.Copy
            oSrcDoc.Windows(1).Activate
            Application.Browser.Target = wdBrowsePage
            Application.Browser.Next

            oNewDoc.Activate
            oNewDoc.Windows(1).Selection.Paste
        Next nSubIndex
        strSrcName = oSrcDoc.FullName
       ' strNewName = fso.BuildPath("D:\1\账扣函", nIndex & ".doc")
       strNewName = fso.BuildPath("D:\1\账扣函", mysheet.Range("A" & (nIndex + 1)).Value & ".doc")
        oNewDoc.SaveAs strNewName
        oNewDoc.Close False
      
    Next nIndex
    Set oNewDoc = Nothing
    Set oRange = Nothing
    Set oSrcDoc = Nothing
    Set fso = Nothing
    MsgBox "结束！"

End Sub