none
Word Code copies over template as opposed to creating seperate document showing all data samples. RRS feed

  • Question

  • The data in my database is transferred to Word (using bookmarks) to save, print and view. It Prints and Saves fine. When it saves it assigns a unique name to each document so the first sheet is not copied over. When it prints it sends each document to the printer before the data in the data sheet is copied over. The issue is with the View only report. Once it completes the first three data points (samples) it copies over the first three with the next three. 

    The issue is when you attempt to view a template that repeats itself. For instance, the template WQ1.dot defines a Location where as WQ2.dot shows all the test samples. If there is only 3 water samples than it prints correctly, however the problem occus if there is more than 3 samples.

    I stepped through the code below so you can see how the parameters are passed in each step. The issue is when printing section 16 data therefore I just included code related to this section. #3 contains the section which is having the issue.  1 and 2 pass parameters

    1) Click on the PRINT SECTION button

    User Clicks on a button
    
    Private Sub ViewSection_Click()
        Dim wrdApp As Object
        Set wrdApp = CreateObject("Word.Application")
        wrdApp.Visible = True
    
        Call PrintItem(Replace(ActiveAttachments, "ITEM_", ""), wrdApp, False, False, "None")
          
        'DoCmd.Close
    End Sub

    2) Calls PrintItem where normally it reads a case statement taking you through each section. I included only Section 16

    Public Sub PrintItem(ItemToPrint As String, _
                          wrdApp As Object, _
                          PrtAttachments As Boolean, _
                          ComparePrt As Boolean, _
                          CompareFolder As String)
    Dim wrdDoc As Object
    Dim AttachmentSection As String
    Dim RecordSource As String
    Dim SaveName As String
    
      If CompareFolder = "" Then
        If Not Forms!PrintApplication("PrintSection" + ItemToPrint) Then
          Exit Sub
        End If
      End If
      docPathname = InstallDir + "sections\mpa-03-" + ItemToPrint + ".dot"
      If Dir(docPathname) = "" Then
        MsgBox ("Blank MPA03 Section " + ItemToPrint + " Not Found.")
        Exit Sub
      End If
      Set wrdDoc = wrdApp.Documents.Add(docPathname)
    
      Call PrintSampleSheets("16", wrdApp, wrdDoc, ComparePrt, CompareFolder)
    
    If ItemToPrint <> 16 And ItemToPrint <> 17 And CompareFolder <> "None" Then
        If ComparePrt Then
          SaveName = CompareFolder + "Section" + ItemToPrint
          wrdDoc.SaveAs FileName:=SaveName
        Else
          wrdDoc.PrintOut
        End If
        wrdDoc.Close SaveChanges:=wdDoNotSaveChanges
        Set wrdDoc = Nothing
      End If
      If PrtAttachments Then
        AttachmentSection = "Section" + ItemToPrint + "Attachments"
        If SubFormExists(AttachmentSection, RecordSource) Then
          Call PrintSelectAttachments(RecordSource)
        End If
      End If
    End Sub

    3) The Print Samples Code is the code where the actual samples (WQ1.dot and WQ2.dot) are printed, saved and Viewed

    Private Sub PrintSampleSheets(ItemSheet As String, _
                                  wrdApp As Object, _
                                  wrdDoc As Object, _
                                  ComparePrt As Boolean, _
                                  CompareFolder As String)
    
    Const gcfHandleErrors As Boolean = False
    If gcfHandleErrors Then On Error GoTo Error_Handler
    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("Stream").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
        
        ' change sample count from 1 to 0
        
        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))
          
          
        wrdDoc.FormFields("ACIDITY" + SampleLoc).Result = IIf(IsNull(rst2(11).Value), "", rst2(11).Value)
        wrdDoc.FormFields("ALKALINITY" + SampleLoc).Result = IIf(IsNull(rst2(12).Value), "", rst2(12).Value)
        wrdDoc.FormFields("Depth" + SampleLoc).Result = IIf(IsNull(rst2(13).Value), "", rst2(13).Value)
        wrdDoc.FormFields("Discharge" + SampleLoc).Result = IIf(IsNull(rst2(14).Value), "", rst2(14).Value)
        wrdDoc.FormFields("FEDISS" + SampleLoc).Result = IIf(IsNull(rst2(15).Value), "", rst2(15).Value)
        wrdDoc.FormFields("FETOTAL" + SampleLoc).Result = IIf(IsNull(rst2(16).Value), "", rst2(16).Value)
        wrdDoc.FormFields("MDISS" + SampleLoc).Result = IIf(IsNull(rst2(17).Value), "", rst2(17).Value)
        wrdDoc.FormFields("MTOTAL" + SampleLoc).Result = IIf(IsNull(rst2(18).Value), "", rst2(18).Value)
        wrdDoc.FormFields("pH" + SampleLoc).Result = IIf(IsNull(rst2(19).Value), "", Str(rst2(19).Value))
        wrdDoc.FormFields("SODISS" + SampleLoc).Result = IIf(IsNull(rst2(20).Value), "", Str(rst2(20).Value))
        wrdDoc.FormFields("CONDUCTIVITY" + SampleLoc).Result = IIf(IsNull(rst2(20).Value), "", Str(rst2(20).Value))
        wrdDoc.FormFields("SETTSOLIDS" + SampleLoc).Result = IIf(IsNull(rst2(9).Value), "", Str(rst2(9).Value))
        wrdDoc.FormFields("TDS" + SampleLoc).Result = IIf(IsNull(rst2(10).Value), "", rst2(10).Value)
        wrdDoc.FormFields("TSS" + SampleLoc).Result = IIf(IsNull(rst2(9).Value), "", rst2(9).Value)
        wrdDoc.FormFields("ODISS" + SampleLoc).Result = IIf(IsNull(rst2(8).Value), "", rst2(8).Value)
        wrdDoc.FormFields("Temp" + SampleLoc).Result = IIf(IsNull(rst2(7).Value), "", rst2(7).Value)
          
          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
      
    Error_Handler_Exit:
        On Error Resume Next
        Exit Sub
    
    Error_Handler:
        MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
                "Error Number: " & err.Number & vbCrLf & _
                "Error Source: PrintSampleSheets" & vbCrLf & _
                "Error Description: " & err.Description, _
                vbCritical, "An Error has Occured!"
        Resume Error_Handler_Exit
      
    End Sub


    jim neal

    Tuesday, October 30, 2012 12:26 AM

Answers

  • Hi Jim,

    In looking at your code I have a few initial questions to get a better understanding of what you are doing.
    1) When you mention viewing a template that repeats itself what exactly are you referring to?
    2) Are you seeing a duplicate template or is the data in one template overwriting another template?

    Since you mentioned the issue happens with only more than 3 samples, we are wondering if the issue may stem from the if statement below that we found in your code.  Inside of the if statement there are some lines of code that look like they are creating the SaveName for the file.

    If SampleCnt > 3 Then

    I would recommend that you set watches on some of the variables in that section to make sure they are giving you the correct values you would expect.  I would start with the SaveName variable. 

    Please let me know if that helps narrow down where the issue is actually happening.

    Travis Oelschlager

    Microsoft Online Community Support

    • Marked as answer by JamesLNeal Saturday, November 3, 2012 10:42 AM
    Wednesday, October 31, 2012 7:45 PM

All replies

  • Hi jim,

    I will involve some experts who are familiar with this issue, and it may take some time. Much appreciate for your patience.

    Best Regards,


    Leo_Gao [MSFT]
    MSDN Community Support | Feedback to us

    Wednesday, October 31, 2012 1:48 AM
    Moderator
  • Thank you - any assistance would be appreciated.

    jim neal

    Wednesday, October 31, 2012 3:57 PM
  • Hi Jim,

    In looking at your code I have a few initial questions to get a better understanding of what you are doing.
    1) When you mention viewing a template that repeats itself what exactly are you referring to?
    2) Are you seeing a duplicate template or is the data in one template overwriting another template?

    Since you mentioned the issue happens with only more than 3 samples, we are wondering if the issue may stem from the if statement below that we found in your code.  Inside of the if statement there are some lines of code that look like they are creating the SaveName for the file.

    If SampleCnt > 3 Then

    I would recommend that you set watches on some of the variables in that section to make sure they are giving you the correct values you would expect.  I would start with the SaveName variable. 

    Please let me know if that helps narrow down where the issue is actually happening.

    Travis Oelschlager

    Microsoft Online Community Support

    • Marked as answer by JamesLNeal Saturday, November 3, 2012 10:42 AM
    Wednesday, October 31, 2012 7:45 PM
  • On the Water Quality Sample sheet (WQ2.dot) there are places for 3 samples and each sample has various water tests. When there are only 3 samples the template (wq2.dot) displays and the three samples are written to it. However, if there are 4 or more samples you can see the first three samples written and then the 4th sample is written over the 1st sample, the 5th over the second and so on. There have been times when there have been 20 seperate samples. The following code catches and handles this when the template is either saved or printed is the sample count is greater than 3. Not sure how I can change it to catch (store) multiple copies of the WQ2.dot

    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

    There is only one sample template. If the user chooses the save button then each template is given a name which prevents the copying over. If Print is chosen each sheet is sent to the printer.

    Thank you!


    jim neal

    Thursday, November 1, 2012 1:28 AM
  • Hi Jim

    Just to help clear up a question of terminology: when you use the Documents.Add method you're actually creating a new document based on the specified template. So your code isn't working directly on any templates - it's creating a series of new documents.

    I, too, am suspicious of the loop over the second recordset and the If SampleCnt > 3 Then section.

    It's not clear to me what is actually happening when this evaluates to true.  You write "However, if there are 4 or more samples you can see the first three samples written and then the 4th sample is written over the 1st sample, the 5th over the second and so on. "

    Does this mean that, when the file is saved, each repeat is being saved to the same file name? It's not the samples being replaced, but the entire file? If that's the case, then I'd suspect SampleSheetCnt, although I can't see an obvious resetting of the value.

    Since we can't possibly test your code, my recommendation would be for you to place a breakpoint in the first line after the "If" clause (click in the line then press F9), then step through the "If" (press F8). You can monitor the values of the various variables by hovering the mouse pointer over them...


    Cindy Meister, VSTO/Word MVP, my blog

    Thursday, November 1, 2012 5:29 PM
    Moderator
  • Sometime you only have to step away from the code for a few days and come back to find the answer. Once the number of samples exceeded 3 I wasn't calling another instance of the template. Instead I was using the same one. Once I called the template again after If SampleCnt > 3 Then - it works perfect

    Set wrdDoc = wrdApp.Documents.Add(docPathname)

    I also had to move the Save calls up since the code after "If ComparePrt Then" was not working correctly.

    Thanks all you helped!

          If SampleCnt > 3 Then
         
          SaveName = CompareFolder + "Section" + ItemSheet + "Site" + Trim(Str(SiteCnt)) + "SampleSheet" + Trim(Str(SampleSheetCnt))
          SampleSheetCnt = SampleSheetCnt + 1
          wrdDoc.SaveAs FileName:=SaveName
               
          Set wrdDoc = wrdApp.Documents.Add(docPathname)
         
            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


    jim neal


    • Edited by JamesLNeal Saturday, November 3, 2012 12:12 PM
    Saturday, November 3, 2012 10:42 AM