Microsoft VBA and Printing to templates using code

J

jimneal

Joined
Sep 21, 2012
Messages
1
Reaction score
0
I have an application where reviwers test two types of water samples (ground water, table 16_5 and surface water, 17_5) for contaminants. They enter in the location of the water source and a multitude of samples
The data displays correctly in the form and in the tables. If the reviewers need a hard copy of the report they click a print button and the data from the tables is transferred to two Microsoft Word documents, ws1 (location) and ws2.dot (samples) using code and bookmarks.
The bookmarks are working correcly because I do get at least one location and its corresponding samples to print print correctly. The first two locations and corresponding samples will print correctly. The third location prints correctly and the sample document displays with the permit number and correct location ID but none of the sample data displays and the entire print job is terminated. The following error displays:
"The Requested member of the collection does not exist."
When I step through the code it fails at the line
"wrdDoc.FormFields("Sample" + SampleLoc).Result = IIf(IsNull(rst2(1).Value), "", rst2(1).Value)"

Code: 
Private Sub PrintSampleSheets(ItemSheet As String, _
                              wrdApp As Object, _
                              wrdDoc As Object, _
                              ComparePrt As Boolean, _
                              CompareFolder As String)
Dim rst, rst2 As Recordset
Dim docPathname As String
Dim SampleCnt As Integer
Dim SampleLoc As String
Dim SamplePrinted As Boolean
Dim SiteCnt As Integer
Dim SampleSheetCnt As Integer
Dim SaveName As String
Dim CurrentSample As Long
  
  
  SiteCnt = 1
  Set rst = CurrentDb.OpenRecordset("Section" + ItemSheet + "_5_Qry")
  Do While Not rst.EOF()
    docPathname = InstallDir + "sections\wq1.dot"
    If Dir(docPathname) = "" Then
      MsgBox ("WQ Form Not Found.")
      Exit Sub
    End If
    Set wrdDoc = wrdApp.Documents.Add(docPathname)
    wrdDoc.FormFields("PermitNumber").Result = IIf(IsNull(Forms!main!PermitNumber.Value), "", Forms!main!PermitNumber.Value)
    wrdDoc.FormFields("StationNumber").Result = IIf(IsNull(rst(0).Value), "", rst(0).Value)
    wrdDoc.FormFields("SOAP").Result = IIf(IsNull(Forms!main!Section6!SOAP_Number.Value), "", Forms!main!Section6!SOAP_Number.Value)
    wrdDoc.FormFields("County").Result = IIf(IsNull(rst(7).Value), "", rst(7).Value)
    wrdDoc.FormFields("Basin").Result = IIf(IsNull(rst(8).Value), "", rst(8).Value)
    wrdDoc.FormFields("QUAD").Result = IIf(IsNull(rst(9).Value), "", rst(9).Value)
    Select Case rst(10).Value
      Case 1
        wrdDoc.FormFields("Lake").CheckBox.Value = True
      Case 2
        wrdDoc.FormFields("Discharge").CheckBox.Value = True
      Case 3
        wrdDoc.FormFields("Influent").CheckBox.Value = True
      Case 4
        wrdDoc.FormFields("Spring").CheckBox.Value = True
      Case 5
        wrdDoc.FormFields("Spring").CheckBox.Value = True
      Case 6
        wrdDoc.FormFields("Well").CheckBox.Value = True
    End Select
    wrdDoc.FormFields("Depth").Result = IIf(IsNull(rst(11).Value), "", rst(11).Value)
    wrdDoc.FormFields("Diameter").Result = IIf(IsNull(rst(12).Value), "", rst(12).Value)
    wrdDoc.FormFields("Aquifer").Result = IIf(IsNull(rst(13).Value), "", rst(13).Value)
    wrdDoc.FormFields("TopOfAuifer").Result = IIf(IsNull(rst(14).Value), "", rst(14).Value)
    wrdDoc.FormFields("Thickness").Result = IIf(IsNull(rst(15).Value), "", rst(15).Value)
    wrdDoc.FormFields("Elevation").Result = IIf(IsNull(rst(16).Value), "", rst(16).Value)
    wrdDoc.FormFields("Watershed").Result = IIf(IsNull(rst(17).Value), "", rst(17).Value)
    wrdDoc.FormFields("DrainageArea").Result = IIf(IsNull(rst(18).Value), "", rst(18).Value)
    wrdDoc.FormFields("Lat_Degree").Result = IIf(IsNull(rst(1).Value), "", Str(rst(1).Value))
    wrdDoc.FormFields("Lat_Min").Result = IIf(IsNull(rst(2).Value), "", Str(rst(2).Value))
    wrdDoc.FormFields("Lat_Sec").Result = IIf(IsNull(rst(3).Value), "", Str(rst(3).Value))
    wrdDoc.FormFields("Long_Degree").Result = IIf(IsNull(rst(4).Value), "", Str(rst(4).Value))
    wrdDoc.FormFields("Long_Min").Result = IIf(IsNull(rst(5).Value), "", Str(rst(5).Value))
    wrdDoc.FormFields("Long_Sec").Result = IIf(IsNull(rst(6).Value), "", Str(rst(6).Value))
    wrdDoc.FormFields("Stream").Result = IIf(IsNull(rst(19).Value), "", rst(19).Value)
    wrdDoc.FormFields("Permittee").Result = IIf(IsNull(Forms!main!Section3!ApplName.Value), "", Forms!main!Section3!ApplName.Value)
    wrdDoc.FormFields("Collecting").Result = IIf(IsNull(rst(20).Value), "", rst(20).Value)
    wrdDoc.FormFields("Analyzing").Result = IIf(IsNull(rst(21).Value), "", rst(21).Value)
    
    Call PrintComment("Comments", IIf(IsNull(rst(22).Value), "", rst(22).Value), wrdDoc, True)
    Set rst2 = CurrentDb.OpenRecordset("select * from Section" + ItemSheet + "_5_Data_Qry where Station_Number = '" + rst(0).Value + "'")
    If Not rst2.EOF() Then
        If CompareFolder <> "None" Then
            If ComparePrt Then
              SaveName = CompareFolder + "Section" + ItemSheet + "Site" + Trim(Str(SiteCnt)) + "Sheet"
              wrdDoc.SaveAs FileName:=SaveName
            Else
              wrdDoc.PrintOut
            End If
            wrdDoc.Close SaveChanges:=wdDoNotSaveChanges
            Set wrdDoc = Nothing
        End If
    End If
    SampleSheetCnt = 1
    SampleCnt = 0
    SamplePrinted = False
    If Not rst2.EOF Then
      docPathname = InstallDir + "sections\wq2.dot"
      If Dir(docPathname) = "" Then
        MsgBox ("WQ Form Not Found.")
        Exit Sub
      End If
      Set wrdDoc = wrdApp.Documents.Add(docPathname)
      wrdDoc.FormFields("PermitNumber").Result = IIf(IsNull(Forms!main!PermitNumber.Value), "", Forms!main!PermitNumber.Value)
      wrdDoc.FormFields("StationNumber").Result = IIf(IsNull(rst(0).Value), "", rst(0).Value)
    End If
    Do While Not rst2.EOF()
      SamplePrinted = True
      If CurrentSample <> rst2(1).Value Then
        SampleCnt = SampleCnt + 1
        CurrentSample = rst2(1).Value
      End If
      If SampleCnt > 3 Then
        If CompareFolder <> "None" Then
            If ComparePrt Then
              SaveName = CompareFolder + "Section" + ItemSheet + "Site" + Trim(Str(SiteCnt)) + "SampleSheet" + Trim(Str(SampleSheetCnt))
              SampleSheetCnt = SampleSheetCnt + 1
              wrdDoc.SaveAs FileName:=SaveName
              wrdDoc.Close SaveChanges:=wdDoNotSaveChanges
              Set wrdDoc = wrdApp.Documents.Add(docPathname)
              wrdDoc.FormFields("PermitNumber").Result = IIf(IsNull(Forms!main!PermitNumber.Value), "", Forms!main!PermitNumber.Value)
              wrdDoc.FormFields("StationNumber").Result = IIf(IsNull(rst(0).Value), "", rst(0).Value)
            Else
              wrdDoc.PrintOut
            End If
        End If
        SampleCnt = 1
      End If
      SampleLoc = Trim(Str(SampleCnt))
      wrdDoc.FormFields("Sample" + SampleLoc).Result = IIf(IsNull(rst2(1).Value), "", rst2(1).Value)
      wrdDoc.FormFields("SampleDate" + SampleLoc).Result = IIf(IsNull(rst2(2).Value), "", Str(rst2(2).Value))
      Select Case rst2(3).Value
        Case "ACID"
          wrdDoc.FormFields("ACIDITY" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("ACIDITYInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "ACIDITY", SampleLoc, wrdDoc)
        Case "ALK"
          wrdDoc.FormFields("ALKALINITY" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("ALKALINITYInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "ALKALINITY", SampleLoc, wrdDoc)
        Case "DPTH"
          wrdDoc.FormFields("Depth" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("DepthInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "DEPTH", SampleLoc, wrdDoc)
        Case "DSCHG"
          wrdDoc.FormFields("Discharge" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("DischargeInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "DISCHARGE", SampleLoc, wrdDoc)
        Case "FED"
          wrdDoc.FormFields("FEDISS" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("FEDISSInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "DISSOLVED IRON", SampleLoc, wrdDoc)
        Case "FET"
          wrdDoc.FormFields("FETOTAL" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("FETOTALInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "TOTAL IRON", SampleLoc, wrdDoc)
        Case "MND"
          wrdDoc.FormFields("MDISS" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("MDISSInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "DISSOLVED MANGANESE", SampleLoc, wrdDoc)
        Case "MNT"
          wrdDoc.FormFields("MTOTAL" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("MTOTALInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "TOTAL MANGANESE", SampleLoc, wrdDoc)
        Case "pH"
          wrdDoc.FormFields("pH" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("pHInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "PH", SampleLoc, wrdDoc)
        Case "SO4"
          wrdDoc.FormFields("SODISS" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("SODISSInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "SULFATE", SampleLoc, wrdDoc)
        Case "SPCON"
          wrdDoc.FormFields("CONDUCTIVITY" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("CONDUCTIVITYInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "CONDUCTIVITY", SampleLoc, wrdDoc)
        Case "SS"
          wrdDoc.FormFields("SETTSOLIDS" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("TempInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "SETTLEABLE SOLIDS", SampleLoc, wrdDoc)
        Case "TDS"
          wrdDoc.FormFields("TDS" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("TDSInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "TOTAL DISSOLVED SOLIDS", SampleLoc, wrdDoc)
        Case "TSS"
          wrdDoc.FormFields("TSS" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("TSSInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "TOTAL SUSPENDED SOLIDS", SampleLoc, wrdDoc)
        Case "DO"
          wrdDoc.FormFields("ODISS" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("ODISSInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "DISSOLVED OXYGEN", SampleLoc, wrdDoc)
        Case "TEMP"
          wrdDoc.FormFields("Temp" + SampleLoc).Result = IIf(IsNull(rst2(4).Value), "", Str(rst2(4).Value))
          wrdDoc.FormFields("TempInd" + SampleLoc).Result = IIf(IsNull(rst2(5).Value), "", rst2(5).Value)
          Call BuildSampleComment(rst2, "TEMPERATURE", SampleLoc, wrdDoc)
      End Select
      rst2.MoveNext
    Loop
    rst2.Close
    rst.MoveNext
    If Not rst.EOF Then
        If CompareFolder <> "None" Then
            If SamplePrinted Then
                If ComparePrt Then
                  SaveName = CompareFolder + "Section" + ItemSheet + "Site" + Trim(Str(SiteCnt)) + "SampleSheet" + Trim(Str(SampleSheetCnt))
                  wrdDoc.SaveAs FileName:=SaveName
                Else
                  wrdDoc.PrintOut
                End If
                wrdDoc.Close SaveChanges:=wdDoNotSaveChanges
                Set wrdDoc = Nothing
            End If
        End If
        SiteCnt = SiteCnt + 1
    End If
  Loop
  If CompareFolder <> "None" Then
    If SamplePrinted Then
      If ComparePrt Then
        SaveName = CompareFolder + "Section" + ItemSheet + "Site" + Trim(Str(SiteCnt)) + "SampleSheet" + Trim(Str(SampleSheetCnt))
        wrdDoc.SaveAs FileName:=SaveName
      Else
        wrdDoc.PrintOut
      End If
      wrdDoc.Close SaveChanges:=wdDoNotSaveChanges
      Set wrdDoc = Nothing
    End If
  End If
  
End Sub
Private Sub BuildSampleComment(rst As Recordset, _
                               SampleType As String, _
                               SampleLoc As String, _
                               wrdDoc As Object)
Dim CommentStr As String
  
  If Not IsNull(rst(6).Value) Then
    CommentStr = SampleType + ":" + rst(6).Value
    wrdDoc.Application.Selection.GoTo what:=wdGoToBookmark, Name:="Comments" + SampleLoc
    wrdDoc.Bookmarks("Comments" + SampleLoc).Delete
    wrdDoc.Application.Selection.TypeText Text:=" " + CommentStr
    wrdDoc.Bookmarks.Add Name:="Comments" + SampleLoc
  End If
End Sub
Sub PrintComment(CommentGoto As String, _
                 CommentText As String, _
                 wrdDoc As Object, _
                 DelField As Boolean)
  wrdDoc.Application.Selection.GoTo what:=wdGoToBookmark, Name:=CommentGoto
  If CommentText = "" Then
    If DelField Then
      wrdDoc.Application.Selection.Tables(1).Select
      wrdDoc.Application.Selection.Tables(1).Delete
    End If
  Else
    wrdDoc.Application.Selection.TypeText Text:=CommentText
  End If
End Sub
 
Stoneboysteve

Stoneboysteve

Joined
Sep 3, 2008
Messages
164
Reaction score
5
What is the value of the SampleCnt variable between these two lines:
End If
SampleSheetCnt = 1

you can insert MsgBox SampleCnt between them.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Slow Code/Query Execution 9
Excel hangs. Why? 1
Excel hangs 1
Conversion from Number to Word!! Aki 1
Error 2465 setting recordsource to SQL 3
Display Numbers as Words 3
Help with code 5
Passing and using field name strings to vba 2

Top