excel 错误4605打开Word文档时另一个文档已经打开

yi0zb3m4  于 2023-05-01  发布在  其他
关注(0)|答案(6)|浏览(319)

所以当我想打开一个特定的word文档时,我在错误处理程序上遇到了这个问题。
到目前为止,当我启动程序时,它所做的是:第一次开始很好。然后,当我再次运行该程序不断加载,直到我手动关闭Word。在此之后,Word给了我一个选项,以只读模式访问该文件。
我已经在论坛和MSDN上搜索了几个小时,现在找不到解决方案。
而且它一直给我
错误代码4605
当我第二次运行代码时。
验证码:

Sub OpenWord()

Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
WordApp.DisplayAlerts = wdAlertsNone

On Error GoTo ErrorHandler:
WordApp.Documents.Open ("C:\Users\mvandalen\Desktop\Test.docx")
WordApp.Visible = True
Exit Sub

''just for testing
VariableCheese = 5 + 5

ErrorHandler:
WordApp.Documents.Close <<< Here it gives error 4605
WordApp.Quit
Resume Next

End Sub

最后编辑:感谢@Brett,我找到了解决方案。我复制了他的代码,并删除了以下行(标记为〉〉〉):

Sub final()

    Set TestDoc = GetObject("C:\Users\mvandalen\Desktop\Test.docx")
>>>>If TestDoc Is Nothing Then
    Set Wd = GetObject(, "Word.Application")
    If Wd Is Nothing Then
        Set Wd = CreateObject("Word.Application")
        If Wd Is Nothing Then
            MsgBox "Failed to start Word!", vbCritical
            Exit Sub
        End If
        >>>>f = True
    **Else** Added line
        **MsgBox "Failed to start Word!", vbCritical** Added line
    End If
    >>>Set TestDoc = Wd.Documents.Open("C:\Users\mvandalen\Desktop\Test.docx")
    >>>If TestDoc Is Nothing Then
        >>>MsgBox "Failed to open help document!", vbCritical
        >>>If f Then
            >>>Wd.Quit
        >>>End If
        >>>Exit Sub
    End If
    Wd.Visible = True
>>>Else
    >>>With WordDoc.Parent
        >>>.Visible = True
        >>>.Activate
    >>>End With
>>>End If

End sub

此代码打开文件一次,然后不再打开,直到关闭它。但由于某种原因,这一行是必需的Set TestDoc = GetObject("C:\Users\mvandalen\Desktop\Test.docx")。否则,Word文档将变为只读。

pn9klfpd

pn9klfpd1#

我会先转到文件〉选项〉常规,看看框中是否有复选标记:Open e-mail attachments and other uneditable files in reading view。如果有,删除它。
来源:https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_windows8-mso_2013_release/run-time-error-4605-in-word-2013-no-information/1ca02c04-5cea-484e-bd23-f4d18183c1b2
也就是说,我的感觉是你试图关闭一个已经关闭(或不活动)的文档,或者没有错误。
要纠正此检查,会出现错误:

If Err <> 0 Then
  ''Insert your error handling code here
  Err.Clear
Resume Next

参见:https://support.microsoft.com/en-au/help/813983/you-receive-run-time-error-4248-4605-or-5941-when-you-try-to-change-pr
或者,问题是您没有检查文档是否已经打开。这可能导致连续循环。我建议使用与下面的示例类似的代码来检测文档是否已经打开。

Set TestDoc = GetObject("C:\Users\mvandalen\Desktop\Test.docx")
If TestDoc Is Nothing Then
    Set Wd = GetObject(, "Word.Application")
    If Wd Is Nothing Then
        Set Wd = CreateObject("Word.Application")
        If Wd Is Nothing Then
            MsgBox "Failed to start Word!", vbCritical
            Exit Sub
        End If
        f = True
    End If
    Set TestDoc = Wd.Documents.Open("C:\Users\mvandalen\Desktop\Test.docx")
    If TestDoc Is Nothing Then
        MsgBox "Failed to open help document!", vbCritical
        If f Then
            Wd.Quit
        End If
        Exit Sub
    End If
    Wd.Visible = True
Else
    With WordDoc.Parent
        .Visible = True
        .Activate
    End With
End If

如果文档已经打开,则此代码将激活该文档。
来源:https://social.msdn.microsoft.com/Forums/en-US/29265e5f-8df9-4cab-8984-1afb9b110d2f/in-excel-use-vba-to-check-if-a-word-document-is-open?forum=isvvba
根据您的新信息,另一个可能的原因是Visual Basic已建立对Word的引用,因为有一行代码调用了Word对象、方法或属性,而没有使用Word对象变量限定元素。在您结束程序之前,VisualBasic不会释放此引用。当代码运行多次时,此错误引用会干扰自动化代码。若要解决此问题,请更改代码,以便使用适当的对象变量限定对Word对象、方法或属性的每次调用。
最接近解释这一点的是一篇Excel文章:https://support.microsoft.com/en-hk/help/178510/excel-automation-fails-second-time-code-runs
为了更好地帮助你,我需要知道:
1.您使用的Word版本。
1.您使用的是MacOS还是Windows。
1.您的宏安全设置是什么?
1.如果你杀死所有的Word进程是否仍然显示错误?
1.文档是仅准备就绪还是以其他方式受保护?
1.如果你打开文档并且它在活动窗口中,当你转到开发者标签并运行宏时,错误仍然会发生吗?
鉴于我们知道文档一直受到保护,请尝试通过进入信任中心并确保Word 2003/7二进制文档和模板不被勾选来删除保护。

k5ifujac

k5ifujac2#

仔细看你的代码,我认为问题在于你没有释放Word对象。由于此代码是从Excel中运行的,因此这些对象将保存在内存中,而不会在宏结束时释放。众所周知,Word在试图打开仍然打开的文档时会遇到问题--因为内存中有一个对象将其保持打开状态。
请看我对你的代码所做的修改,下面是Set [variable] = Nothing行。
(请注意,您在代码示例中混合了变量名“TestDoc”和“WordDoc”-我只是复制了它-因此代码无法正确运行。)

Set TestDoc = GetObject("C:\Users\mvandalen\Desktop\Test.docx")
If TestDoc Is Nothing Then
    Set Wd = GetObject(, "Word.Application")
    If Wd Is Nothing Then
        Set Wd = CreateObject("Word.Application")
        If Wd Is Nothing Then
            MsgBox "Failed to start Word!", vbCritical
            Exit Sub
        End If
        f = True
    End If
    Set TestDoc = Wd.Documents.Open("C:\Users\mvandalen\Desktop\Test.docx")
    If WordDoc Is Nothing Then
        MsgBox "Failed to open help document!", vbCritical
        If f Then
            Wd.Quit
            Set Wd = Nothing
        End If
        Exit Sub
    End If
    Wd.Visible = True
Else
    With WordDoc.Parent
        .Visible = True
        .Activate
    End With
End If
Set WordDoc = Nothing
Set Wd = Nothing
uoifb46i

uoifb46i3#

请尝试以下代码。它:
·启动Word(如果尚未运行)。
·如果文档尚未打开,则打开该文档。
·如果打开了文档,则在编辑后保存并关闭文档。
·如果Word启动了它,则退出它。
当然,如果你想让文档保持打开状态,你可以省略文档关闭和应用退出代码。根据是否要阻止对要保存的文件进行编辑,您可能还需要设置ReadOnly:=True。

Sub OpenWord()
Dim WdApp As Word.Application, WdDoc As Word.Document
Dim bQuit As Boolean, bClose As Boolean
Const StrFlNm As String = "C:\Users\mvandalen\Desktop\Test.docx"
If Dir(StrFlNm) = "" Then
  MsgBox "Cannot find the file:" & vbCr & StrFlNm, vbCritical
  Exit Sub
End If
bQuit = False: bClose = True
On Error Resume Next
Set WdApp = GetObject(, "Word.Application")
If WdApp Is Nothing Then
  Set WdApp = CreateObject("Word.Application")
  On Error GoTo 0
  If WdApp Is Nothing Then
    MsgBox "Can't start Word.", vbExclamation
    Exit Sub
  End If
  bQuit = True
End If
On Error GoTo 0
With WdApp
  .Visible = True
  For Each WdDoc In .Documents
    If WdDoc.FullName = StrFlNm Then
      bClose = False: Exit For
    End If
  Next
  If WdDoc Is Nothing Then
    Set WdDoc = .Documents.Open(Filename:=StrFlNm, ReadOnly:=False, AddToRecentFiles:=False, Visible:=True)
  End If
  With WdDoc
    'Do your document edits here
    If bClose = True Then .Close SaveChanges:=True
  End With
  If bQuit = True Then .Quit
End With
End Sub
cnh2zyt3

cnh2zyt34#

你必须小心处理已经运行Word会话以及无法获得Word会话的可能性
所以你可以使用一个helper函数:

Function GetWord(WordApp As Word.Application) As Boolean
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application") 'try getting an already running Word instance
    If WordApp Is Nothing Then Set WordApp = CreateObject("Word.Application") ' if unsuccesful then try creating a new Word instance
    GetWord = Not WordApp Is Nothing ' notify the result
End Function

因此主代码将被重构如下

Option Explicit

Sub OpenWord()
    Dim WordApp As Word.Application

    If Not GetWord(WordApp) Then 'if unsuccesful in getting/creating a Word session then exit sub
        MsgBox "Couldn't get an existing instance or create a new instance of Word", vbCritical
        Exit Sub
    End If

    With WordApp 'reference the Word session you just got/created
        .DisplayAlerts = wdAlertsNone
        .Visible = True

        On Error GoTo WordErrorHandler:
        .Documents.Open ("C:\Users\mvandalen\Desktop\Test.docx") 

        ' rest of your code exploiting the opened document
    End With

    On Error GoTo 0 'disable Word Error processing

    ' here goes the rest of your code to work without Word object/data


    Exit Sub ' exit not to process statements following 'WordErrorHandler'

WordErrorHandler:
    With WordApp
        If .Documents.Count > 0 Then .Documents.Close '<<< Here it gives error 4605
        .Quit
    End With
    Set WordApp = Nothing
    Resume Next        
End Sub
svujldwt

svujldwt5#

将文档另存为模板(。dotx),并将.Open()更改为.Add()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document

Set WordApp = New Word.Application
Set WordDoc = WordApp.Documents.Add "C:\Users\mvandalen\Desktop\Test.dotx"
WordApp.Visible = True

'...

WordDoc.Close wdDoNotSaveChanges

由于您有对Word的引用,因此无需调用CreateObject("Word.Application")
删除对Word Library的引用并将WordAppWordDoc声明为Object,或使用New关键字。
这样,您可以同时打开任意多个示例。

goucqfw6

goucqfw66#

下面是一个检测Word是否正在运行函数,另一个检测特定文档是否打开:

Friend Function WordIsOpen() As Boolean
         Dim WindowName As String
         Dim FlagWordIsOpen As Boolean
         Dim p() As Process
         p = Process.GetProcessesByName("WinWord")
         If p.Count > 0 Then
            FlagWordIsOpen = True
         Else
            FlagWordIsOpen = False
         End If
         Return FlagWordIsOpen
      End Function

下面是检测文档是否已打开的函数:

Friend Function DocumentIsOpen(Documento As String) As Boolean
         Dim WindowName As String
         Dim FlagOpenDocument As Boolean
         Dim FileName As String
         Dim PathName As String
         If My.Computer.FileSystem.FileExists(Documento) Then
            FileName = My.Computer.FileSystem.GetName(Documento)
         Else
            FileName = Documento
         End If
         Dim lhWndP As Long
         Dim Flag As Boolean
         Flag = False
         Try
            If GetHandleFromPartialCaption(lhWndP, Replace(FileName, System.IO.Path.GetExtension(FileName), "", VB.CompareMethod.Text)) = True Then
               Flag = True
            End If
         Catch
         End Try
         Return Flag
End Function

下面是GetHandleFromPartialCaption函数:

Friend Function GetHandleFromPartialCaption(ByRef lWnd As Long, ByVal sCaption As String) As Boolean
         Dim sStr As String
         Dim strBuilder As New System.Text.StringBuilder(256)
         Dim lhWndP As Long
         Dim Flag As Boolean
         System.Windows.Forms.Application.DoEvents()
         Flag = False
         lhWndP = FindWindow(vbNullString, vbNullString) 'PARENT WINDOW
         Do While lhWndP <> 0
            Try
               sStr = GetText(CType(lhWndP, IntPtr))
               If InStr(sStr.ToUpper(), sCaption.ToUpper(), VB.CompareMethod.Text) > 0 Then
                  Flag = True
                  lWnd = lhWndP
                  Exit Do
               End If
            Catch
            End Try
            lhWndP = GetWindow(CType(lhWndP, IntPtr), GW_HWNDNEXT)
         Loop
         Return Flag
End Function

下面是API的声明:

Friend Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

下面是GetText函数:

Friend Function GetText(ByVal hWnd As IntPtr) As String
         Dim length As Integer

         If hWnd.ToInt32 = 0 Then
            Return Nothing
         End If
         length = GetWindowTextLength(hWnd)
         If length = 0 Then
            Return Nothing
         End If

         Dim sb As New System.Text.StringBuilder("", length)
         GetWindowText(CInt(hWnd), sb, sb.Capacity + 1)
         Return sb.ToString()
      End Function

下面是GetWindowTextLength的声明:

<DllImport("user32.dll")> Friend Function GetWindowTextLength(ByVal hwnd As IntPtr) As Integer
   End Function

下面是GetWindowText的声明:

<DllImport("user32.dll", EntryPoint:="GetWindowText")>
   Friend Function GetWindowText(ByVal hwnd As Integer, ByVal lpString As System.Text.StringBuilder, ByVal cch As Integer) As Integer
   End Function

下面是GetWindow的声明:

<DllImport("user32.dll")> Friend Function GetWindow(ByVal hWnd As IntPtr, uCmd As UInteger) As Long
   End Function

...有点复杂,但我希望它有帮助!

相关问题