來自Access的數據將不會複製到Word書籤

Question

我有一個來自查詢名稱「GrabInfoOfMostRecent」的數據，我使用它作爲Word的來源來填寫帶有書籤的文檔。但是，一旦我找到任何非文本數據，就會收到錯誤438「對象不支持此屬性或方法」。

具體做法是：

1. 對於「MRN」我已經試過.Range.Text /價值/值2的所有變化並不能得到MRN數填入適當的書籤。
2. 對於「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 

爲NULL值轉換成零長度字符串，您可以使用以下內容：

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