Question

我在MS-Access中有一个VBA模块，它应该将数据从数据库加载到MS-Word文档中的表单字段中。我认为它工作正常，但似乎不一致。有时它会起作用，有时则不起作用。我无法弄清楚是什么让它无法工作。当我单步执行调试器时，它不会抛出任何错误，但有时它不会打开MS-Word。

以下是相关代码：

Dim appWord As Word.Application
Dim doc As Word.Document
'Avoid error 429, when Word isn't open.
On Error Resume Next
Err.Clear

'Set appWord object variable to running instance of Word.
Set appWord = GetObject(, "Word.Application")

If Err.Number <> 0 Then
'If Word isn't open, create a new instance of Word.
Set appWord = New Word.Application
End If

Set doc = appWord.Documents.Open("\\srifs01\hresourc\EHS Department\EHS Database\IpadUpload\Lab Inspection Deficiency Resolution Report.docx", , True)

'Sometimes word doesn't open and I think the issue is around here.
With doc
.FormFields("frmID").Result = Me!id
.FormFields("frmSupervisor").Result = Me!LabPOC
.FormFields("frmInspector").Result = Me!InspectorName
.FormFields("frmBuilding").Result = Me!BuildingName
.FormFields("frmRoom").Result = Me!Rooms
.FormFields("frmComments").Result = Me!Comments
.Visible = True
.Activate
.SaveAs "'" & Me!id & "'"
.Close
End With

Set doc = Nothing
Set appWord = Nothing

感谢任何帮助。提前谢谢。

Answer 1

“当我单步执行调试器时，它不会抛出任何错误，但有时它不会打开MS-Word。”

那是因为你有On Error Resume Next。这指示VBA忽略错误。

假设您已在代码中进行了此更改...

Dim strDocPath As String
strDocPath = "\\srifs01\hresourc\EHS Department\EHS Database" & _
    "\IpadUpload\Lab Inspection Deficiency Resolution Report.docx"

然后，当您尝试打开strDocPath时，如果appWord不是对Word应用程序实例的引用，则VBA会抛出错误... AND 您的避风港没有使用On Error Resume Next：

Set doc = appWord.Documents.Open(strDocPath, , True)

如果您将On Error Resume Next的作业更改为此，则可以删除appWord：

Set appWord = GiveMeAnApp("Word.Application")

如果Word已在运行，GiveMeAnApp()将锁定该应用程序实例。如果Word没有运行，GiveMeAnApp()将返回一个新实例。

无论哪种方式，GiveMeAnApp()都不要求您在调用它的过程中使用On Error Resume Next。在那里包含一个适当的错误处理程序。您可以将该函数重用于其他类型的应用程序：GiveMeAnApp("Excel.Application")

Public Function GiveMeAnApp(ByVal pApp As String) As Object
    Dim objApp As Object
    Dim strMsg As String

On Error GoTo ErrorHandler

    Set objApp = GetObject(, pApp)

ExitHere:
    On Error GoTo 0
    Set GiveMeAnApp = objApp
    Exit Function

ErrorHandler:
    Select Case Err.Number
    Case 429 ' ActiveX component can't create object
        Set objApp = CreateObject(pApp)
        Resume Next
    Case Else
        strMsg = "Error " & Err.Number & " (" & Err.Description _
            & ") in procedure GiveMeAnApp"
        MsgBox strMsg
        GoTo ExitHere
    End Select
End Function

在尝试使用应用程序之前，您还可以包含一项检查以确保appWord引用应用程序。虽然我不明白为什么在你的情况下需要进行这样的检查，你可以试试这样的......

If TypeName(appWord) <> "Application" Then
    ' notify user here, and bail out '
Else
    ' appWord.Visible = True '
    ' do stuff with Word '
End If

Answer 2

打开或查找应用程序时，我不使用New关键字。

这是我用于excel的代码：

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err.Number = 429 Then 'Excel not running
    Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0

（另请注意On Error GoTo 0 - 我不希望接下来的简历在整个代码中都是活动的）

Answer 3

GiveMeAnApp功能对我来说非常有用，我遇到了类似的问题。如果我在数据合并后关闭Word文档并尝试将数据另一个合并到Word，则避免错误462（无法连接到服务器等）。（导致错误462）我这样做：一旦我调用GiveMeAnApp，然后在调用Word模板之前调用了一个新的Word文档，我希望将数据传输到Word。

总是让New Word文档在我的情况下出现这个避免的错误462。这意味着我留下了一个空的Word文档，但这对我来说是可以的，并且比我唯一能解决的其他解决办法更可取的是退出db并重新打开并运行合并到Word aga。

我很感激这个帖子中提供的帮助。谢谢大家。

VBA导入MS访问MS Word

3 个答案: