Microsoft Office Forums

Go Back   Microsoft Office Forums > >
Reload this Page Individual Reports Not Being Saved Properly Individual Reports Not Being Saved Properly
Register FAQ

Reply
 
Thread Tools Display Modes
  #1  
Old 05-06-2016, 11:04 AM
JennEx JennEx is offline Individual Reports Not Being Saved Properly Windows XP Individual Reports Not Being Saved Properly Office 2013
Competent Performer
Individual Reports Not Being Saved Properly 		 
Join Date: May 2010
Posts: 162
JennEx is on a distinguished road
Default Individual Reports Not Being Saved Properly

Let us revisit this code ...

Code:
Sub merge2(ByVal i As Long, ByVal ws_vh As Object, ByVal rpt_od As String, objWord As Object)
    'Dim objWord As Object, oDoc As Object
    Dim oDoc As Object
    Dim StrSQL As String, fName As String, StrSrc As String, strFilename As String
    Dim ws_th As Worksheet
    Dim qfile As String, st_srchnfn As String, wb_qfile2 As Workbook
    
    
    Const wdSendtToNewDocument = 0
    Const wdSendToPrinter = 1
    Const wdFormLetters = 0
    Const wdDirectory = 3
    Const wdMergeSubTypeAccess = 1
    Const wdOpenFormatAuto = 0
 
    'Const itype As String = "DR"
    'Const isubresp As String = "WPL"
    
    qfile2 = ws_vh.Range("B4")
    
    st_srchfn = "H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\" & qfile2
    Set wb_qfile2 = Workbooks(qfile2)
    If wb_qfile2 Is Nothing Then
        MsgBox qfile2 & " is NOT open."
    Else
        'MsgBox qfile2 & " is open"
        wb_qfile2.Close False
        
    End If
    
    
    
    Set ws_th = Workbooks("Sports15b.xlsm").Worksheets("TEMP_HOLD")
    
    itype = Right(ws_th.Range("A" & i), 2)
    isubresp = Left(ws_th.Range("A" & i), 3)
    
    If itype = "DR" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\DR15v1.docx"
    ElseIf itype = "DT" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\DT15v1.docx"
    ElseIf itype = "FR" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\FR15v1.docx"
    ElseIf itype = "FT" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\FT15v1.docx"
    ElseIf itype = "CR" Then
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\CR15v1.docx"
    Else
        fName = "H:\PWS\Parks\Parks Operations\Sports\Sports15\REPORTS\v1\CT15v1.docx"
    End If
    
    StrSrc = "H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\" & ws_vh.Range("B4")
 
    StrSQL = "SELECT * FROM [CORE$] WHERE [TYPE]='" & itype & "' AND [SIG_CREW]='" & isubresp & "' " & _
        "ORDER BY [STARTS] ASC, [COMPLEX] ASC, [UNIT] ASC"
 
    'Set objWord = CreateObject("Word.Application")
    With objWord
        .DisplayAlerts = False
        .Visible = True
        Set oDoc = .documents.Open(Filename:=fName, ConfirmConversions:=False, _
            ReadOnly:=True, AddToRecentFiles:=False, Visible:=True)
        With oDoc
            With .MailMerge
                .MainDocumentType = wdFormLetters
                .Destination = wdSendtToNewDocument
                .SuppressBlankLines = True
                .OpenDataSource Name:=StrSrc, AddToRecentFiles:=False, LinkToSource:=False, ConfirmConversions:=False, _
                    ReadOnly:=True, Format:=wdOpenFormatAuto, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "User ID=Admin;Data Source=" & StrSrc & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";", _
                    SQLStatement:=StrSQL, SQLStatement1:="", SubType:=wdMergeSubTypeAccess
                .Execute Pause:=False
            End With
            .Close False
        End With
        .DisplayAlerts = True
        
        With .ActiveDocument
            If .Sections.Count > 1 Then
                For Each HdFt In .Sections(.Sections.Count).Headers
                    If HdFt.Exists Then
                        HdFt.Range.FormattedText = .Sections(1).Headers(HdFt.Index).Range.FormattedText
                        HdFt.Range.Characters.Last.Delete
                    End If
                Next
                For Each HdFt In .Sections(.Sections.Count).Footers
                    If HdFt.Exists Then
                        HdFt.Range.FormattedText = .Sections(1).Footers(HdFt.Index).Range.FormattedText
                        HdFt.Range.Characters.Last.Delete
                    End If
                Next
            End If
            Do While .Sections.Count > 1
                .Sections(1).Range.Characters.Last.Delete
                DoEvents
            Loop
            .Range.Characters.Last.Delete
        End With
    End With

    Set oDoc2 = objWord.ActiveDocument
    With oDoc2
        myPath = "H:\PWS\Parks\Parks Operations\Sports\Sports15\WORKORDERS\" & Format(ws_vh.Range("B2"), "ddd dd-mmm-yy")
        .SaveAs myPath & "\" & rpt_od & ".docx"
    End With
        
    AppActivate "Microsoft Excel"
    Set oDoc = Nothing: Set oDoc2 = Nothing ': Set objWord = Nothing
    'End If
End Sub
In my excel application, I have a loop that calls this merge routine 'x' amount of times. Each loop has a calls for the need for a different report as defined by "rpt_od".

In my example, three different reports need be created. rpt_od = HPE-DT, RPE_FR, and WPE-FR. The merge routine will be called three times.

Here is my issue ... I believe it has something to do with either the .close false statement (not closing the newly created document), or the With .ActiveDocument line (not identifying the correct document as being the active document).

When HPE-DT is created, it is named and saved as HPE-DT.docx. It remains accessible, ie not closed. The next merge routine is called to merge to the document for RPE-FR. The merge is successful and a new document is created. However, it is not saved. The former HPE-DT is resaved with the name RPE-FR.docx. The newly created document sits open named "letters2.docx" and is not saved. When I run the merge routine for the third report, WPE-FR, the RPE-FR.docx is resaved as WPE-FR. The most recently created document sits open named "letters3.docx"

I now have the same document saved under three different names. Only the first one is the proper one. I have two unsaved proper documents. I have to save them as and overwrite the incorrect file.

What must I do to correct this situation? I would like to have the documents saved as created, but remain open for the user to preview and edit before printing.

Thank you all in advance.
Reply With Quote
  #2  
Old 05-06-2016, 02:28 PM
JennEx JennEx is offline Individual Reports Not Being Saved Properly Windows XP Individual Reports Not Being Saved Properly Office 2013
Competent Performer
Individual Reports Not Being Saved Properly 		 
Join Date: May 2010
Posts: 162
JennEx is on a distinguished road
Default
Here is the code that is calling the merge. I think it may be part of the problem.

Code:
Private Sub cb_preview_Click()
    Dim ws_vh As Worksheet, ws_th As Worksheet, ws_lists As Worksheet
    Dim path As String, dirname As String, dest1 As String
    Dim riq As Double
    Dim objWord As Object
    
    Set ws_vh = Workbooks("sports15b.xlsm").Worksheets("VAR_HOLD")
    Set ws_th = Workbooks("sports15b.xlsm").Worksheets("TEMP_HOLD")
    Set objWord = CreateObject("Word.Application")
    
    If Me.tb_of_rpt = 0 Then
        MsgBox "No reports have been selected.", vbExclamation, "ERROR"
        Exit Sub
    End If
    
    'populate print que
    With ws_th
        'Reg Diamonds
        If Me.tglb_cue_diar.Value = True Then
            last_cell
            .Range("A" & lj) = "CUE-DR"
        End If
        If Me.tglb_hpe_diar.Value = True Then
                last_cell
            .Range("A" & lj) = "HPE-DR"
        End If
        If Me.tglb_rpe_diar.Value = True Then
                last_cell
            .Range("A" & lj) = "RPE-DR"
        End If
        If Me.tglb_wpe_diar.Value = True Then
                last_cell
            .Range("A" & lj) = "WPE-DR"
        End If
        
        If Me.tglb_cul_diar.Value = True Then
            last_cell
            .Range("A" & lj) = "CUL-DR"
        End If
        If Me.tglb_hpl_diar.Value = True Then
                last_cell
            .Range("A" & lj) = "HPL-DR"
        End If
        If Me.tglb_rpl_diar.Value = True Then
                last_cell
            .Range("A" & lj) = "RPL-DR"
        End If
        If Me.tglb_wpl_diar.Value = True Then
                last_cell
            .Range("A" & lj) = "WPL-DR"
        End If
       
        'Trn Diamonds
        If Me.tglb_cue_diat.Value = True Then
                last_cell
            .Range("A" & lj) = "CUE-DT"
        End If
        If Me.tglb_hpe_diat.Value = True Then
                last_cell
            .Range("A" & lj) = "HPE-DT"
        End If
        If Me.tglb_rpe_diat.Value = True Then
                last_cell
            .Range("A" & lj) = "RPE-DT"
        End If
        If Me.tglb_wpe_diat.Value = True Then
                last_cell
            .Range("A" & lj) = "WPE-DT"
        End If
        If Me.tglb_cul_diat.Value = True Then
                last_cell
            .Range("A" & lj) = "CUL-DT"
        End If
        If Me.tglb_hpl_diat.Value = True Then
                last_cell
            .Range("A" & lj) = "HPL-DT"
        End If
        If Me.tglb_rpl_diat.Value = True Then
                last_cell
            .Range("A" & lj) = "RPL-DT"
        End If
        If Me.tglb_wpl_diat.Value = True Then
                last_cell
            .Range("A" & lj) = "WPL-DT"
        End If
        
        'Reg Fields
        If Me.tglb_cue_fldr.Value = True Then
            last_cell
            .Range("A" & lj) = "CUE-FR"
        End If
        If Me.tglb_hpe_fldr.Value = True Then
            last_cell
            .Range("A" & lj) = "HPE-FR"
        End If
        If Me.tglb_rpe_fldr.Value = True Then
            last_cell
            .Range("A" & lj) = "RPE-FR"
        End If
        If Me.tglb_wpe_fldr.Value = True Then
            last_cell
            .Range("A" & lj) = "WPE-FR"
        End If
        If Me.tglb_cul_fldr.Value = True Then
            last_cell
            .Range("A" & lj) = "CUL-FR"
        End If
        If Me.tglb_hpl_fldr.Value = True Then
            last_cell
            .Range("A" & lj) = "HPL-FR"
        End If
        If Me.tglb_rpl_fldr.Value = True Then
            last_cell
            .Range("A" & lj) = "RPL-FR"
        End If
        If Me.tglb_wpl_fldr.Value = True Then
            last_cell
            .Range("A" & lj) = "WPL-FR"
        End If
        
        'Trn Fields
        If Me.tglb_cue_fldt.Value = True Then
            last_cell
            .Range("A" & lj) = "CUE-FT"
        End If
        If Me.tglb_hpe_fldt.Value = True Then
            last_cell
            .Range("A" & lj) = "HPE-FT"
        End If
        If Me.tglb_rpe_fldt.Value = True Then
            last_cell
            .Range("A" & lj) = "RPE-FT"
        End If
        If Me.tglb_wpe_fldt.Value = True Then
            last_cell
            .Range("A" & lj) = "WPE-FT"
        End If
        If Me.tglb_cul_fldt.Value = True Then
            last_cell
            .Range("A" & lj) = "CUL-FT"
        End If
        If Me.tglb_hpl_fldt.Value = True Then
            last_cell
            .Range("A" & lj) = "HPL-FT"
        End If
        If Me.tglb_rpl_fldt.Value = True Then
            last_cell
            .Range("A" & lj) = "RPL-FT"
        End If
        If Me.tglb_wpl_fldt.Value = True Then
            last_cell
            .Range("A" & lj) = "WPL-FT"
        End If
        
        'Reg Courts
        If Me.tglb_cue_crtr.Value = True Then
            last_cell
            .Range("A" & lj) = "CUE-CR"
        End If
        If Me.tglb_hpe_crtr.Value = True Then
            last_cell
            .Range("A" & lj) = "HPE-CR"
        End If
        If Me.tglb_rpe_crtr.Value = True Then
            last_cell
            .Range("A" & lj) = "RPE-CR"
        End If
        If Me.tglb_wpe_crtr.Value = True Then
            last_cell
            .Range("A" & lj) = "WPE-CR"
        End If
        If Me.tglb_cul_crtr.Value = True Then
            last_cell
            .Range("A" & lj) = "CUL-CR"
        End If
        If Me.tglb_hpl_crtr.Value = True Then
            last_cell
            .Range("A" & lj) = "HPL-CR"
        End If
        If Me.tglb_rpl_crtr.Value = True Then
            last_cell
            .Range("A" & lj) = "RPL-CR"
        End If
        If Me.tglb_wpl_crtr.Value = True Then
            last_cell
            .Range("A" & lj) = "WPL-CR"
        End If
        'Trn Courts
        If Me.tglb_cue_crtt.Value = True Then
            last_cell
            .Range("A" & lj) = "CUE-CT"
        End If
        If Me.tglb_hpe_crtt.Value = True Then
            last_cell
            .Range("A" & lj) = "HPE-CT"
        End If
        If Me.tglb_rpe_crtt.Value = True Then
            last_cell
            .Range("A" & lj) = "RPE-CT"
        End If
        If Me.tglb_wpe_crtt.Value = True Then
            last_cell
            .Range("A" & lj) = "WPE-CT"
        End If
        If Me.tglb_cul_crtt.Value = True Then
            last_cell
            .Range("A" & lj) = "CUL-CT"
        End If
        If Me.tglb_hpl_crtt.Value = True Then
            last_cell
            .Range("A" & lj) = "HPL-CT"
        End If
        If Me.tglb_rpl_crtt.Value = True Then
            last_cell
            .Range("A" & lj) = "RPL-CT"
        End If
        If Me.tglb_wpl_crtt.Value = True Then
            last_cell
            .Range("A" & lj) = "WPL-CT"
        End If
    End With
    
    'create directory
        path = "H:\PWS\Parks\Parks Operations\Sports\Sports15\WORKORDERS\"
        dirname = Format(ws_vh.Range("B2"), "ddd dd-mmm-yy")
        dest1 = path & dirname
        On Error Resume Next
        MkDir dest1
        On Error GoTo 0
        
    'how many reports in que
        riq = WorksheetFunction.CountA(ws_th.Range("A2:A49")) + 1
        
    'create reports
    For i = 2 To riq
        Me.tb_cur_rpt = Me.tb_cur_rpt + 1
        rpt_od = ws_th.Range("A" & i)
        If rpt_od = "CUE-DR" Then
            Me.tglb_cue_diar.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "CUL-DR" Then
            Me.tglb_cul_diar.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "HPE-DR" Then
            Me.tglb_hpe_diar.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "HPL-DR" Then
            Me.tglb_hpl_diar.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "RPE-DR" Then
            Me.tglb_rpe_diar.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "RPL-DR" Then
            Me.tglb_rpl_diar.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "WPE-DR" Then
            Me.tglb_wpe_diar.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "WPL-DR" Then
            Me.tglb_wpl_diar.BackColor = RGB(229, 38, 38)
            
        ElseIf rpt_od = "CUE-DT" Then
            Me.tglb_cue_diat.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "CUL-DT" Then
            Me.tglb_cul_diat.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "HPE-DT" Then
            Me.tglb_hpe_diat.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "HPL-DT" Then
            Me.tglb_hpl_diat.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "RPE-DT" Then
            Me.tglb_rpe_diat.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "RPL-DT" Then
            Me.tglb_rpl_diat.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "WPE-DT" Then
            Me.tglb_wpe_diat.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "WPL-DT" Then
            Me.tglb_wpl_diat.BackColor = RGB(229, 38, 38)
            
        ElseIf rpt_od = "CUE-FR" Then
            Me.tglb_cue_fldr.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "CUL-FR" Then
            Me.tglb_cul_fldr.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "HPE-FR" Then
            Me.tglb_hpe_fldr.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "HPL-FR" Then
            Me.tglb_hpl_fldr.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "RPE-FR" Then
            Me.tglb_rpe_fldr.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "RPL-FR" Then
            Me.tglb_rpl_fldr.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "WPE-FR" Then
            Me.tglb_wpe_fldr.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "WPL-FR" Then
            Me.tglb_wpl_fldr.BackColor = RGB(229, 38, 38)
            
        ElseIf rpt_od = "CUE-FT" Then
            Me.tglb_cue_fldt.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "CUL-FT" Then
            Me.tglb_cul_fldt.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "HPE-FT" Then
            Me.tglb_hpe_fldt.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "HPL-FT" Then
            Me.tglb_hpl_fldt.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "RPE-FT" Then
            Me.tglb_rpe_fldt.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "RPL-DT" Then
            Me.tglb_rpl_fldt.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "WPE-FT" Then
            Me.tglb_wpe_fldt.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "WPL-FT" Then
            Me.tglb_wpl_fldt.BackColor = RGB(229, 38, 38)
            
        ElseIf rpt_od = "CUE-CR" Then
            Me.tglb_cue_crtr.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "CUL-CR" Then
            Me.tglb_cul_crtr.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "HPE-CR" Then
            Me.tglb_hpe_crtr.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "HPL-CR" Then
            Me.tglb_hpl_crtr.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "RPE-CR" Then
            Me.tglb_rpe_crtr.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "RPL-CR" Then
            Me.tglb_rpl_crtr.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "WPE-CR" Then
            Me.tglb_wpe_diar.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "WPL-CR" Then
            Me.tglb_wpl_crtr.BackColor = RGB(229, 38, 38)
            
        ElseIf rpt_od = "CUE-CT" Then
            Me.tglb_cue_crtt.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "CUL-CT" Then
            Me.tglb_cul_crtt.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "HPE-CT" Then
            Me.tglb_hpe_crtt.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "HPL-CT" Then
            Me.tglb_hpl_crtt.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "RPE-CT" Then
            Me.tglb_rpe_crtt.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "RPL-CT" Then
            Me.tglb_rpl_crtt.BackColor = RGB(229, 38, 38)
        ElseIf rpt_od = "WPE-CT" Then
            Me.tglb_wpe_crtt.BackColor = RGB(229, 38, 38)
        Else
            Me.tglb_wpl_crtt.BackColor = RGB(229, 38, 38)
        End If
        
        merge2 i, ws_vh, rpt_od, objWord ', pr, pn, path_name '[module 39]
        
        On Error Resume Next
        fn99 = ws_vh.Range("B4")
        Set wBook = Workbooks(fn99)
        If wBook Is Nothing Then
            'open workbook after having been closed during report making
            Workbooks.Open ("H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\" & fn99)
            ActiveWorkbook.Windows(1).Visible = False
            Set wBook = Nothing
            On Error GoTo 0
        End If
        On Error GoTo 0
        
        If rpt_od = "CUE-DR" Then
            Me.tglb_cue_diar.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "CUL-DR" Then
            Me.tglb_cul_diar.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "HPE-DR" Then
            Me.tglb_hpe_diar.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "HPL-DR" Then
            Me.tglb_hpl_diar.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "rPE-DR" Then
            Me.tglb_rpe_diar.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "rPL-DR" Then
            Me.tglb_rpl_diar.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "WPE-DR" Then
            Me.tglb_wpe_diar.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "WPL-DR" Then
            Me.tglb_wpl_diar.BackColor = RGB(0, 153, 0)
            
        ElseIf rpt_od = "CUE-DT" Then
            Me.tglb_cue_diat.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "CUL-DT" Then
            Me.tglb_cul_diat.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "HPE-DT" Then
            Me.tglb_hpe_diat.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "HPL-DT" Then
            Me.tglb_hpl_diat.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "RPE-DT" Then
            Me.tglb_rpe_diat.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "RPL-DT" Then
            Me.tglb_rpl_diat.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "WPE-DT" Then
            Me.tglb_wpe_diat.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "WPL-DT" Then
            Me.tglb_wpl_diat.BackColor = RGB(0, 153, 0)
            
        ElseIf rpt_od = "CUE-FR" Then
            Me.tglb_cue_fldr.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "CUL-FR" Then
            Me.tglb_cul_fldr.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "HPE-FR" Then
            Me.tglb_hpe_fldr.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "HPL-FR" Then
            Me.tglb_hpl_fldr.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "RPE-FR" Then
            Me.tglb_rpe_fldr.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "RPL-FR" Then
            Me.tglb_rpl_fldr.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "WPE-FR" Then
            Me.tglb_wpe_fldr.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "WPL-FR" Then
            Me.tglb_wpl_fldr.BackColor = RGB(0, 153, 0)
            
        ElseIf rpt_od = "CUE-FT" Then
            Me.tglb_cue_fldt.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "CUL-FT" Then
            Me.tglb_cul_fldt.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "HPE-FT" Then
            Me.tglb_hpe_fldt.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "HPL-FT" Then
            Me.tglb_hpl_fldt.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "RPE-FT" Then
            Me.tglb_rpe_fldt.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "RPL-DT" Then
            Me.tglb_rpl_fldt.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "WPE-FT" Then
            Me.tglb_wpe_fldt.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "WPL-FT" Then
            Me.tglb_wpl_fldt.BackColor = RGB(0, 153, 0)
            
        ElseIf rpt_od = "CUE-CR" Then
            Me.tglb_cue_crtr.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "CUL-CR" Then
            Me.tglb_cul_crtr.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "HPE-CR" Then
            Me.tglb_hpe_crtr.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "HPL-CR" Then
            Me.tglb_hpl_crtr.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "RPE-CR" Then
            Me.tglb_rpe_crtr.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "RPL-CR" Then
            Me.tglb_rpl_crtr.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "WPE-CR" Then
            Me.tglb_wpe_diar.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "WPL-CR" Then
            Me.tglb_wpl_crtr.BackColor = RGB(0, 153, 0)
            
        ElseIf rpt_od = "CUE-CT" Then
            Me.tglb_cue_crtt.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "CUL-CT" Then
            Me.tglb_cul_crtt.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "HPE-CT" Then
            Me.tglb_hpe_crtt.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "HPL-CT" Then
            Me.tglb_hpl_crtt.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "RPE-CT" Then
            Me.tglb_rpe_crtt.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "RPL-CT" Then
            Me.tglb_rpl_crtt.BackColor = RGB(0, 153, 0)
        ElseIf rpt_od = "WPE-CT" Then
            Me.tglb_wpe_crtt.BackColor = RGB(0, 153, 0)
        Else
            Me.tglb_wpl_crtt.BackColor = RGB(0, 153, 0)
        End If
        MsgBox "Report for " & rpt_od & " completed.", vbInformation, "SUCCESS"
        Me.tb_of_rpt = Me.tb_of_rpt - 1
        ws_th.Range("A" & i) = ""
    Next i
    MsgBox Me.tb_cur_rpt.Value & " report(s) created and saved.", vbInformation, "SUCCESS"
    objWord.Quit
    Set objWord = Nothing
End Sub
It's not quite right either. If I just wish to print one report, it insists on merging more reports that requested. It seems to compound the more times I print individually.
Reply With Quote
  #3  
Old 05-08-2016, 09:30 AM
JennEx JennEx is offline Individual Reports Not Being Saved Properly Windows XP Individual Reports Not Being Saved Properly Office 2013
Competent Performer
Individual Reports Not Being Saved Properly 		 
Join Date: May 2010
Posts: 162
JennEx is on a distinguished road
Default
Has anyone any idea?

Cross posted here to reach a broader audience.
Reply With Quote
  #4  
Old 05-08-2016, 03:10 PM
JennEx JennEx is offline Individual Reports Not Being Saved Properly Windows XP Individual Reports Not Being Saved Properly Office 2013
Competent Performer
Individual Reports Not Being Saved Properly 		 
Join Date: May 2010
Posts: 162
JennEx is on a distinguished road
Default
It appears I have found the problem.
Reply With Quote
  #5  
Old 05-08-2016, 06:20 PM
macropod's Avatar
macropod macropod is offline Individual Reports Not Being Saved Properly Windows 7 64bit Individual Reports Not Being Saved Properly Office 2010 32bit
Administrator
  
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,514
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default
Quote:
Originally Posted by JennEx View Post
It appears I have found the problem.
Ah, but have you found the solution??

It appears all you need to do is move:
Code:
            myPath = "H:\PWS\Parks\Parks Operations\Sports\Sports15\WORKORDERS\" & Format(ws_vh.Range("B2"), "ddd dd-mmm-yy")
            .SaveAs myPath & "\" & rpt_od & ".docx"
to follow your last:
.Range.Characters.Last.Delete
and you don't need any of:
Code:
    Set oDoc2 = objWord.ActiveDocument
    With oDoc2
        myPath = "H:\PWS\Parks\Parks Operations\Sports\Sports15\WORKORDERS\" & Format(ws_vh.Range("B2"), "ddd dd-mmm-yy")
        .SaveAs myPath & "\" & rpt_od & ".docx"
    End With
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #6  
Old 05-09-2016, 07:32 AM
JennEx JennEx is offline Individual Reports Not Being Saved Properly Windows XP Individual Reports Not Being Saved Properly Office 2013
Competent Performer
Individual Reports Not Being Saved Properly 		 
Join Date: May 2010
Posts: 162
JennEx is on a distinguished road
Default
Hi Paul ... great to hear from you.

Did I find the solution? It certainly isn't what you had suggested, but what I did seems to be working. Is it correct? Dunno. Could it cause, or be causing, other issues? Good chance LOL.

All I did was was put
Code:
Set objWord = CreateObject("Word.Application")
back in after the StrSQL = line.

??
Reply With Quote
  #7  
Old 05-09-2016, 01:37 PM
macropod's Avatar
macropod macropod is offline Individual Reports Not Being Saved Properly Windows 7 64bit Individual Reports Not Being Saved Properly Office 2010 32bit
Administrator
  
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,514
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default
I didn't bother with 'Set objWord = CreateObject("Word.Application")' because I saw you were passing it as a parameter and assumed, therefore, that you had created objWord in the calling routine.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #8  
Old 05-23-2016, 05:28 AM
JennEx JennEx is offline Individual Reports Not Being Saved Properly Windows XP Individual Reports Not Being Saved Properly Office 2013
Competent Performer
Individual Reports Not Being Saved Properly 		 
Join Date: May 2010
Posts: 162
JennEx is on a distinguished road
Default
Hi Paul, I hope all is well with you these days.
I know you have a lot of dedication to this forum, so rather than start a new post, I figured I'd stay with this one as it's all the same project.

I am happy to report that with all of your help things are fundamentally working very well! Definitely have you to thank in most part!

Two little annoyances perhaps youcan assist me in overcoming.

1) Since having worked through this problem in my original post, all my created reports are opened in Word and are available to view, edit and print etc. Oddly though, to print, I have to first click on an open Excel window, and return to the Word document before I can access any print commands. Weird or what? Perhaps my fix wasn't the solution.

2) Not certain if you can help me with this one based on limited information provided. My reports are "quasi directory" style ... providing the same format as a directory style merge (more than one record per page), but since we were unable to use the directory style, we had to use the letters style and tweak the code to recognize records by sections. (I think)

In most part, the multiple tables (used to display each record), fit nicely on each page. I have concluded that my DR reports can only fit 2 tables (records) per page. However, on occassion, the merge will try to sneak a third one on. The entire table does not fit on the page, just the first couple rows. So, the record (table) get broken between two pages. 3 or 4 carriage returns is usually all that is needed to push the partial record to the next page.

Is there a way I can ensure only two records are displayed per page? I had tried by placing carriage returns in the merge document after and or before the table, but it left an unsightly gap between tables in the final document. If possible, I'd like to keep the bulk of empty space after the last record displayed on the page.

The idea is to minimize the amount of user interaction to reach the preferred final product. Eventually, I am hoping to send these reports directly to the printer (minus the viewing option used now only to make this edit), but not until I can be certain that they reports will print as hoped.
Reply With Quote
  #9  
Old 05-23-2016, 05:46 AM
macropod's Avatar
macropod macropod is offline Individual Reports Not Being Saved Properly Windows 7 64bit Individual Reports Not Being Saved Properly Office 2010 32bit
Administrator
  
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,514
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default
Hi Jenn,

After the table, try inserting a field coded as:
{IF{=MOD({MERGESEQ},2) \# 0}= 0 {QUOTE 12}}
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #10  
Old 05-23-2016, 02:43 PM
JennEx JennEx is offline Individual Reports Not Being Saved Properly Windows XP Individual Reports Not Being Saved Properly Office 2013
Competent Performer
Individual Reports Not Being Saved Properly 		 
Join Date: May 2010
Posts: 162
JennEx is on a distinguished road
Default
Hi Paul ...

Thank you for the suggestion. I entered the line the best I could. Other than the curly brackets, which I used CTRL-F9 to insert, I manually typed in the text. Not sure if that is how I was supposed to or not. I've pondered over looking for any discrepencies but haven't found anything obvious. Perhaps I am lacking a space, or put a space in where one shouldn't.

Needless to say, receiving an error associated with that field.

"Error! Unknown op code for conditional"

Can I assume also that problem #1 is as much a mystery to you as to me?
Attached Files
File Type: docx DR15v1.docx (384.9 KB, 9 views)
Reply With Quote
  #11  
Old 05-23-2016, 04:43 PM
macropod's Avatar
macropod macropod is offline Individual Reports Not Being Saved Properly Windows 7 64bit Individual Reports Not Being Saved Properly Office 2010 32bit
Administrator
  
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,514
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default
The problem is with your field coding. Whereas I said you should code it as:
{IF{=MOD({MERGESEQ},2) \# 0}= 0 {QUOTE 12}}
you've used:
{IF{=MOD({MERGESEQ},2) \# 0}=0 {QUOTE 12}}
Note the space after the '=' in my code! It's the little things that make all the difference...
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #12  
Old 05-23-2016, 04:46 PM
macropod's Avatar
macropod macropod is offline Individual Reports Not Being Saved Properly Windows 7 64bit Individual Reports Not Being Saved Properly Office 2010 32bit
Administrator
  
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,514
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default
Quote:
Originally Posted by JennEx View Post
Can I assume also that problem #1 is as much a mystery to you as to me?
I hadn't given much thought to that, but I don't see why it should be so. Perhaps your macro needs the Excel window to be active for the code to release the Word document. It may be just a transient glitch with your system.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #13  
Old 06-22-2016, 03:01 PM
macropod's Avatar
macropod macropod is offline Individual Reports Not Being Saved Properly Windows 7 64bit Individual Reports Not Being Saved Properly Office 2010 32bit
Administrator
  
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,514
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default
Hi Jen,

With the code you now have, to execute the merge, you'd add something like to following, to run on the output document post-merge.
Code:
With wdApp.ActiveDocument.Range
  While .Characters.Last.Previous Like "[" & vbCr & Chr(12) & "]"
    .Characters.Last.Previous.Delete
  Wend
End With
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
Reply

« Previous Thread | Next Thread »


Similar Threads
Thread Thread Starter Forum Replies Last Post
Individual Reports Not Being Saved Properly Last version not saved properly Tumtum Word 1 08-15-2015 12:59 PM
Individual Reports Not Being Saved Properly Visual Reports OTPM Project 3 02-12-2015 08:54 AM
Video not working when saved as .ppt But does when saved as .pptx patientxwolf PowerPoint 5 01-24-2014 02:16 PM
Task List Reports dbsoccer Outlook 1 04-06-2013 06:33 AM
Individual Reports Not Being Saved Properly Merge Reports... DMA-Pacific Word 1 03-27-2012 11:49 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 03:38 PM.

Contact Us - Privacy Statement - Top

Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft