Question

我有来自查询名称“GrabInfoOfMostRecent”的数据，我使用它作为Word的源来填写带有书签的文档。但是，一旦我得到任何非文本数据，我得到错误438“对象不支持此属性或方法”。

具体来说：

对于“MRN”，我已经尝试过.Range.Text / Value / Value2的所有变体，并且无法将MRN编号填入相应的书签。
对于“Diagnosis1”，我得到一个Error13“Type Mismatch”，但我不知道为什么。它被定义为“短文本”，就像所有以前的文本条目一样。

任何有任何帮助的人，我都会非常感激。

Sub WordAutomation()
On Error GoTo HandleError

' Object variables for Automation stuff
' declare them like so during development
' you need to set a reference to the applications
'Dim objWord As New Word.Application
' declare them like this when development is complete
' references no longer necessary

Dim objWord As Object

' Object variables for database access
Dim db As DAO.Database
Dim rstPatientVisit As DAO.Recordset
Dim rsReportData As DAO.Recordset
Dim rsExclusions As DAO.Recordset

' Scalar variables
Dim strsql As String
Dim strFile As String
Dim conPath As String
Dim wdGoToBookmark As Integer

'find the folder where the database resides
Set db = CurrentDb
Set rsReportData = db.OpenRecordset("GrabInfoOfMostRecent")


strFile = db.Name
conPath = Mid(strFile, 1, Len(strFile) - Len(Dir(strFile)))

'Step through the records one at a time, creating a Word
'document for each.
'Do While Not rsReportData.EOF

'--create new word document
Set objWord = CreateObject("Word.Application")
objWord.Documents.Add conPath & "TunTemplate.dotx"

' Make both Word and the document are visible
objWord.Visible = True
objWord.Windows(1).Visible = True

'find bookmarks and insert values
With objWord.ActiveDocument.Bookmarks
    .Item("RDFirst").Range.Text = rsReportData!RDFirstName
    .Item("RDLast").Range.Text = rsReportData!RDLastName
    .Item("PFirstName").Range.Text = rsReportData!PVFirstName
    .Item("PLastName").Range.Text = rsReportData!PVLastName
    .Item("MRN").Range.Value2 = rsReportData!MRN
    .Item("RDAddress").Range.Text = rsReportData!RDAddress
    .Item("PAddress").Range.Text = rsReportData!Address
    .Item("RDCity").Range.Text = rsReportData!RDCity
    .Item("RDCounty").Range.Text = rsReportData!RDCounty
    .Item("PCity").Range.Text = rsReportData!City
    .Item("PCounty").Range.Text = rsReportData!County
    .Item("RDPostalCode").Range.Text = rsReportData!RDPostalCode
    .Item("PPostalCode").Range.Text = rsReportData!PostalCode
    .Item("Diagnosis1").Range.Text = rsReportData!Diagnosis1
    .Item("Treatment1").Range.Text = rsReportData!Treatment1
    .Item("Changes1").Range.Text = rsReportData!Changes1
    .Item("Diagnosis2").Range.Text = rsReportData!Diagnosis2
    .Item("Treatment2").Range.Text = rsReportData!Treatment2
    .Item("Changes2").Range.Text = rsReportData!Changes2
    .Item("Diagnosis3").Range.Text = rsReportData!Diagnosis3
    .Item("Treatment3").Range.Text = rsReportData!Treatment3
    .Item("Changes3").Range.Text = rsReportData!Changes3
    .Item("Diagnosis4").Range.Text = rsReportData!Diagnosis4
    .Item("Treatment4").Range.Text = rsReportData!Treatment4
    .Item("Changes4").Range.Text = rsReportData!Changes4
    .Item("Diagnosis5").Range.Text = rsReportData!Diagnosis5
    .Item("Treatment5").Range.Text = rsReportData!Treatment5
    .Item("Changes5").Range.Text = rsReportData!Changes5
    .Item("Weight").Range.Text = rsReportData!Weight
    .Item("Height").Range.Text = rsReportData!Height
    .Item("BMICalc").Range.Text = rsReportData!BMICalc
    .Item("Waist").Range.Text = rsReportData!Waist
    .Item("BP").Range.Text = rsReportData!BP
    .Item("RAcuity").Range.Text = rsReportData!REyeAcuity
    .Item("LAcuity").Range.Text = rsReportData!LEyeAcuity
    .Item("RRetina").Range.Text = rsReportData!RLensRetina
    .Item("LRetina").Range.Text = rsReportData!LLensRetina
    .Item("HbA1c").Range.Text = rsReportData!HbA1C
    .Item("Creatinine").Range.Text = rsReportData!Creatinine
    .Item("TChol").Range.Text = rsReportData!TChol
    .Item("UrineACR").Range.Text = rsReportData!UrineACR
    .Item("LDL").Range.Text = rsReportData!LDL
    .Item("TSH").Range.Text = rsReportData!TSH
    .Item("HDL").Range.Text = rsReportData!HDL
    .Item("B12").Range.Text = rsReportData!B12
    .Item("TG").Range.Text = rsReportData!TG
    .Item("EGFR").Range.Text = rsReportData!EGFR
End With

'find and write exclusion data
strsql = "SELECT ReportID, Exclusion " & _
    "FROM ExclusionData " & _
    "WHERE ReportID=" & rsReportData!ReportID

Set rsExclusions = db.OpenRecordset(strsql)
    Do While Not rsExclusions.EOF
    With objWord.ActiveDocument.Bookmarks
        .Item("exclusions").Range.Text = rsExclusions!Exclusion & vbCrLf
        rsExclusions.MoveNext
    End With
Loop
rsExclusions.Close


'Save the document and close Word
objWord.ActiveDocument.SaveAs (conPath & rsReportData!MRN & ".doc")
'objWord.Quit

'go to next record for processing
'rsReportData.MoveNext
'Loop


'Tell the user the process is done.
MsgBox "Done!" & vbCrLf & vbCrLf & _
"Look in this directory" & vbCrLf & conPath & vbCrLf & _
"for your documents."

ProcDone:

' clean up our object variables
Set objWord = Nothing
Set rsReportData = Nothing
Set rsExclusions = Nothing
Set db = Nothing

ExitHere:
Exit Sub
HandleError:
'display appropriate error message
Select Case Err.Number
    Case 5151 'Word template not found
        'Close stranded applications
        MsgBox "Word template not found"
    Case 5152 'Invalid file name
        'Close stranded applications
        objWord.ActiveDocument.Close SaveChanges:=False
        objWord.Quit
        MsgBox "This file or folder does not exist"
    Case Else
        MsgBox Err.Description, vbExclamation, _
         "Error " & Err.Number
End Select
Resume ProcDone
End Sub

Answer 1

只需要帮助您排除故障;我提供以下内容。

尝试使用以下方法将问题字段转换为字符串：

.Item("Diagnosis1").Range.Text = CStr(rsReportData!Diagnosis1)

您可能还希望显示包含rsReportData!Diagnosis1：

内容的对话框

MsgBox "rsReportData!Diagnosis1 is: " & rsReportData!Diagnosis1 _
    , vbOkOnly + vbInformation

要将空值转换为零长度字符串，可以使用以下命令：

.Item("Diagnosis1").Range.Text= IIf(IsNull(rsReportData!Diagnosis1), "", rsReportData!Diagnosis1)

Access中的数据不会复制到Word书签

1 个答案: