在VBA中运行代码时获取运行时错误438。投诉“ExcelApp.Quit SaveChanges:=wdDoNotSaveChanges”

在VBA中运行代码时获取运行时错误438。投诉“ExcelApp.Quit SaveChanges:=wdDoNotSaveChanges”,excel,vba,hyperlink,Excel,Vba,Hyperlink,我正在尝试让这段代码正常工作,目的是在excel文件中选择一系列超链接excel文件,按下命令按钮并打印它们。我已经设法打印了一次,但在那之后,我得到了运行时错误438。请参见下面发生错误的代码行上方发生错误的位置 我是VBA新手,如果有人能解释错误发生的原因并提供解决方案,我将不胜感激 Sub ExportToWordAndPrint() With Sheets("SOBar") Const Ttl As String = "Excel Print" Dim cell As Range D

我正在尝试让这段代码正常工作,目的是在excel文件中选择一系列超链接excel文件,按下命令按钮并打印它们。我已经设法打印了一次,但在那之后,我得到了运行时错误438。请参见下面发生错误的代码行上方发生错误的位置

我是VBA新手,如果有人能解释错误发生的原因并提供解决方案,我将不胜感激

Sub ExportToWordAndPrint()

With Sheets("SOBar")

Const Ttl As String = "Excel Print"
Dim cell As Range
Dim rng As Range
Dim FullNameOfFile As String
Dim ExcelApp As Object, MyDoc As Object

On Error Resume Next
Set ExcelApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then Set ExcelApp = CreateObject("Excel.Application")
On Error GoTo 0


If ExcelApp Is Nothing Then
MsgBox "Microsoft Word is not installed on this computer - operation cancelled.", vbCritical + 
vbOKOnly, Ttl
Exit Sub
End If

ExcelApp.Visible = True

Set rng = Selection


For Each cell In rng

With rng

On Error Resume Next
FullNameOfFile = ""
FullNameOfFile = cell.Hyperlinks(1).Address
On Error GoTo 0

If FullNameOfFile <> "" Then 'cell may not have contained a Hyperlink

    If Dir(FullNameOfFile) <> "" Then 'cell may contain a Hyperlink, but the file itself may not exist

        'Debug.print cell.address & " should print"    'THIS ONE ADDED
        With ExcelApp
            Set MyDoc = .Workbooks.Open(Filename:=FullNameOfFile)
            MyDoc.PrintOut
            Application.Wait (Now() + TimeValue("0:00:1"))
            .ActiveWindow.Close SaveChanges:=False
        End With
    Else         'THIS ONE ADDED
        'Debug.Print cell.Address & " failed, appears to have wrong filename"
    End If
Else             'THIS ONE ADDED
    'Debug.Print cell.Address & " failed, appears to have no hyperlink"
End If

End With
Next cell

'This is where error occur
ExcelApp.Quit SaveChanges:=wdDoNotSaveChanges
Set ExcelApp = Nothing

End With

End Sub
word没有角色。它只是按钮调用的子程序的名称。忽略有关ms word的注释,这是VBA excel中的一个代码,用于打印excel文档中的超链接excel文档:–15分钟前的David44

你把MS Excel和MS Word弄混了?ExcelApp是Excel应用程序,您的消息框显示此计算机上未安装其他MsgBox Microsoft Word

另外,WDDONOTSAVECHANGS是MS Word常量,而不是MS Excel常量。我建议在顶部也添加OptionExplicit

我还建议不要使用选择,而是使用适当的范围对象。如果仍要使用该选择,请检查它是否为有效选择,如下面的代码所示

这就是你想要的吗?未经测试


避免使用ExcelApp。从同一项目中退出。您可能正在处理其他工作簿,可能会丢失这些更改。如果您仍然想使用它,请注意可能的重新循环。

您好!不,我没有混淆word和excel。我从一个朋友那里得到了代码,他认为我需要打印超链接word文档,然后将其修改为excel。我想使用选择,因为我工作的文档中有~3000个超链接。我已经编辑了我的答案。这就是您正在尝试的吗?您是从Excel还是Word运行此代码?谢谢您的回答:但这是针对Excel文件中的超链接Excel文件,我想使用“选择和命令”按钮打印。我试图将constwddonotsavechanges添加为Integer=0和optionexplicit,但随后我得到了其他bug Range=Nothing。我可能需要多练习一些基础知识……您从哪里运行此代码?从Excel运行此代码:那么Word在这方面扮演什么角色?
Option Explicit

Sub Sample()
    Dim ws As Worksheet, wb As Workbook
    Dim rng As Range, aCell As Range
    Dim FullNameOfFile As String

    '~~> Use this object with the right range object
    '~~> instead of using `Selection`
    Set ws = ThisWorkbook.Sheets("SOBar")

    '~~> Instead of selection use something like this
    '~~> Change it to the relevant range
    'Set rng = ws.Range("A1:A10")

    '~~> Check if what the user selected is a valid range
    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a range first."
        Exit Sub
    End If

    Set rng = Selection

    For Each aCell In rng
        FullNameOfFile = ""

        On Error Resume Next
        FullNameOfFile = aCell.Hyperlinks(1).Address
        On Error GoTo 0

        If FullNameOfFile <> "" Then
            If Dir(FullNameOfFile) <> "" Then
                Set wb = Workbooks.Open(FullNameOfFile)
                wb.PrintOut
                DoEvents
                wb.Close (False)
            End If
        End If
    Next aCell
End Sub