#1
|
|||
|
|||
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 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. |
#2
|
|||
|
|||
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 |
#4
|
|||
|
|||
It appears I have found the problem.
|
#5
|
||||
|
||||
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" .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] |
#6
|
|||
|
|||
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") ?? |
#7
|
||||
|
||||
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] |
#8
|
|||
|
|||
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. |
#9
|
||||
|
||||
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] |
#10
|
|||
|
|||
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? |
#11
|
||||
|
||||
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] |
#12
|
||||
|
||||
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] |
#13
|
||||
|
||||
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] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Last version not saved properly | Tumtum | Word | 1 | 08-15-2015 12:59 PM |
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 |
Merge Reports... | DMA-Pacific | Word | 1 | 03-27-2012 11:49 PM |