Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Word / Programming / May 2008

Tip: Looking for answers? Try searching our database.

pausing and resume

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
jishith - 22 May 2008 09:19 GMT
hello i am using this code for generating word report, want to pause thise
word report generation and resume when needed( may after the restarting the
system)
the entire code for generating word report i have pasted. The data are
fetching from temp table created in Access.
want to know how to pause these generation and resume when needed.

'declaration of global constant SQL server connection string
Const ConnectionString_SQLServer = "DSN=AE-BE-Issue-Log"
Dim appWord As Word.Application
Dim doc As Word.Document
Dim toc As TableOfContents
'declaration of global variables
Dim PresentDb As Database
Dim qdef As QueryDef
Dim strWhere As String
Dim strWhereProjectID As String               'string to be concatenated
with the query string which adds the where clause for ProjectID
Dim strWhereReleaseVersion As String      'string to be concatenated with
the query string which adds the where clause for ReleaseVersion
Dim strWhereValidationCycle As String      'string to be concatenated with
the query string which adds the where clause for ValidationCycle
Dim responseBenchIssues As Integer
Dim saveFolderPath As String
Dim saveSubFolderPath As String
Dim varTestScriptName As String
Dim tbl As Word.Table
Dim rowCount As Long
Dim tblFAIL As Word.Table
Dim rowCountFAIL As Long
Dim tblHWFAIL As Word.Table
Dim rowCountHWFAIL As Long
Dim tblSWFAIL As Word.Table
Dim rowCountSWFAIL As Long
Dim tblSpecFAIL As Word.Table
Dim rowCountSpecFAIL As Long
Dim tblBenchFAIL As Word.Table
Dim rowCountBenchFAIL As Long
       

Private Sub cmdBack_Click()
On Error GoTo Err_cmdBack_Click
   
   'close the current form and open "opening form"
   Dim stDocName As String
'This function generates WORD reports of the testscripts present in the
[Temp_TestScripts] Table
Public Sub cmdWordReport_Generate(varProjectID As String, varReleaseVersion
As String)
   
   Dim subDoc As Word.Document
   Dim currentFolderPath As String
   Dim fs As FileSystemObject
   Dim wordReportFolder As Folder
   Dim oConnection As ADODB.Connection
   Dim rs As ADODB.Recordset
   Dim progressCancelStatus As Boolean
   Dim varCustomerName As String
   Dim varHandlingDept As String
   Dim varTestEngineer As String
   Dim varVehicleTest As String
   Dim varBench As String
   Dim varCreatedOn As String

On Error GoTo the_error
 
   Set oConnection = New ADODB.Connection
   oConnection = CurrentProject.Connection
   Set rs = New ADODB.Recordset

   
   'currentFolderPath is set to the path of the folder in which the test
reports are generated
   currentFolderPath = CurrentProject.path
   saveFolderPath = saveFolderPath & "\" & "TestLogDB_Reports_" &
varReleaseVersion
   saveSubFolderPath = saveFolderPath & "\" & "subReports"
   
   'check if the folder is already present otherwise create the folder
   Set fs = New FileSystemObject
   If (fs.FolderExists(saveFolderPath)) Then
       Set wordReportFolder = fs.GetFolder(saveFolderPath)
   Else
       Set wordReportFolder = fs.CreateFolder(saveFolderPath)
   End If
   
   If (fs.FolderExists(saveSubFolderPath)) Then
       Set wordReportFolder = fs.GetFolder(saveSubFolderPath)
   Else
       Set wordReportFolder = fs.CreateFolder(saveSubFolderPath)
   End If
   
   'open the main test report format file
   Set appWord = New Word.Application
   Set doc = appWord.Documents.Open(FileName:=CurrentProject.path & "\" &
"TestReport_Format_TestLogDB.doc", Visible:=False)
   appWord.Visible = False
   'save it as another file
   doc.SaveAs (saveFolderPath & "\" & "TestReportSummary" &
varReleaseVersion & ".doc")
   doc.Close
   Set doc = Nothing
   
   'open the saved file
   Set doc = appWord.Documents.Open(FileName:=saveFolderPath & "\" &
"TestReportSummary" & varReleaseVersion & ".doc", Visible:=False)
   Dim rng As Word.Range
   Set rng = doc.Range(Start:=0, End:=doc.Range.End)

   oConnection.Open
   rs.Open "SELECT CustomerName,HandlingDept FROM Project WHERE ProjectID =
'" & varProjectID & "' ", oConnection
   varCustomerName = rs.Fields(0)
   varHandlingDept = rs.Fields(1)
   rs.Close
   
   rs.Open "SELECT TestEngineer,Bench,VehicleTest FROM Release WHERE
ReleaseVersion = '" & varReleaseVersion & "' ", oConnection
   varTestEngineer = rs.Fields(0)
   varBench = rs.Fields(1)
   If (rs.Fields(2) = 0) Then
   varVehicleTest = "No"
   Else
   varVehicleTest = "Yes"
   End If
   rs.Close
   varCreatedOn = ""
   varTestScriptName = ""
       
   oConnection.Close

   'Print the TestScriptName at the End of the document
   rng.InsertParagraphAfter
   rng.InsertParagraphAfter
   rng.SetRange rng.End, rng.End
   rng.Style = wdStyleHeading3
   rng.InsertAfter ("    " & "Issue summary")
     
   'create a table to display the General Issues
   rng.Tables.Add Range:=rng, NumRows:=3, NumColumns:=2
   Set tblFAIL = rng.Tables(1)
   tblFAIL.Cell(1, 1).Range.Text = "General Issues"
   tblFAIL.Cell(2, 1).Range.Text = "TestCase Name"
   tblFAIL.Cell(2, 2).Range.Text = "Link to TestScript"
   rowCountFAIL = 3
 
   rng.SetRange doc.Range.End, doc.Range.End
   rng.InsertParagraphAfter
   rng.InsertParagraphAfter
   rng.SetRange rng.End, rng.End
   
   'create a table to display the SW issues
   rng.Tables.Add Range:=rng, NumRows:=3, NumColumns:=2
   Set tblSWFAIL = rng.Tables(1)
   tblSWFAIL.Cell(1, 1).Range.Text = "Software Issues"
   tblSWFAIL.Cell(2, 1).Range.Text = "TestCase Name"
   tblSWFAIL.Cell(2, 2).Range.Text = "Link to TestScript"
   rowCountSWFAIL = 3
       
   'create a table to display the Bench Issues
   rng.Tables.Add Range:=rng, NumRows:=3, NumColumns:=2
   Set tblBenchFAIL = rng.Tables(1)
   tblBenchFAIL.Cell(1, 1).Range.Text = "Bench Tester Issues"
   tblBenchFAIL.Cell(2, 1).Range.Text = "TestCase Name"
   tblBenchFAIL.Cell(2, 2).Range.Text = "Link to TestScript"
   rowCountFAIL = 3
   
   rng.SetRange doc.Range.End, doc.Range.End
   rng.InsertParagraphAfter
   rng.InsertParagraphAfter
   rng.SetRange rng.End, rng.End
   
   'Print the TestScriptName at the End of the document
   rng.InsertParagraphAfter
   rng.InsertParagraphAfter
   rng.SetRange rng.End, rng.End
   rng.Style = wdStyleHeading3
   rng.InsertAfter ("    " & "Test Cases Overview")
   
   rng.SetRange doc.Range.End, doc.Range.End
   rng.InsertParagraphAfter
   rng.InsertParagraphAfter
   rng.SetRange rng.End, rng.End
   
   'create a table to display the testscript names and their Outcome
   rng.Tables.Add Range:=rng, NumRows:=3, NumColumns:=2
   Set tbl = rng.Tables(1)
   rowCount = 2
   tbl.Cell(1, 1).Range.Text = "TestScript Name"
   tbl.Cell(1, 2).Range.Text = "Outcome"

   'display the progress bar
   DoCmd.OpenForm "Progress Status"
   [Form_Progress Status].ProgressBar.Value = 0
   [Form_Progress Status].lblFileStatus.Caption = "Getting information from
Database..."
   [Form_Progress Status].Repaint

   'calculate the status of the testcases in the selected testscripts
   DoCmd.RunSQL "DELETE * FROM [Temp_Testcases]"
   DoCmd.RunSQL "INSERT INTO [Temp_Testcases] SELECT
TestCaseName,Comment,ReviewStatus,TestCaseStatus,TestCaseTime,TestScriptID
FROM TestCase WHERE TestScriptID IN (SELECT TestScriptID FROM
[Temp_TestScripts]) "
   DoCmd.RunSQL "UPDATE [Temp_Testcases] SET [Temp_Testcases].FinalStatus =
[Temp_Testcases].ReviewStatus"
   DoCmd.RunSQL "UPDATE [Temp_Testcases] SET [Temp_Testcases].FinalStatus =
2 WHERE [Temp_Testcases].ReviewStatus = 2 OR ([Temp_Testcases].ReviewStatus =
1 AND [Temp_Testcases].TestCaseStatus = 1)"

   [Form_Progress Status].lblFileStatus.Caption = "Preparing WORD reports..."
   [Form_Progress Status].Repaint

   oConnection.Open
   rs.Open "SELECT  TestScriptID, TestScriptName,TestScriptStatus,CreatedOn
FROM [Temp_TestScripts] ORDER BY TestScriptID", oConnection, adOpenStatic,
adLockReadOnly
     
 
       'create a sub report to display the testcases and their testevents
       Set subDoc = appWord.Documents.Open(FileName:=CurrentProject.path &
"\" & "SubReport_Format_TestLogDB.doc", Visible:=False)
       subDoc.SaveAs (saveSubFolderPath & "\" & rs(1).Value & ".doc")
       Set subDoc = appWord.Documents.Open(FileName:=saveSubFolderPath &
"\" & rs(1).Value & ".doc", Visible:=False)
       
       If (rs(3).Value = Null) Then
           varCreatedOn = "Not Available in DB"
       Else
           varCreatedOn = rs(3).Value
       End If
       
       If (rs(1).Value = Null) Then
           varTestScriptName = "Not Available in DB"
       Else
           varTestScriptName = rs(1).Value
       End If
           
     
       'convert the TestScript name into an Hyperlink of the sub report
document
       doc.Hyperlinks.Add Anchor:=tbl.Cell(rowCount, 1).Range,
Address:=".\" & rs(1).Value & ".doc", TextToDisplay:=rs(1).Value
       
       'Print the status of the testscript in the table
       If (rs.Fields(2) = 0) Then
           tbl.Cell(rowCount, 2).Range.Text = "FAIL"
           tbl.Rows(rowCount).Range.Font.Color = wdColorRed
       Else
           tbl.Cell(rowCount, 2).Range.Text = "PASS"
           tbl.Rows(rowCount).Range.Font.Color = wdColorBlack
       End If
       tbl.Cell(rowCount, 1).Range.InsertAfter vbCrLf
       tbl.Rows.Add
       rowCount = rowCount + 1
     
       'Display the file count on the progress window
       [Form_Progress Status].lblFileProgress.Caption = "File " & (rowCount
- 2) & " Out of " & rs.recordCount

       appWord.Visible = False
       
       'This functon prints the testcases & testevents into the sub report
and returns the status as to whether the Cancel button has been pressed or
not.
       progressCancelStatus = CreateSubWordReport(subDoc, rs(1).Value,
rs(0).Value, oConnection)
       
       'if Cancel has been pressed in the Progress window eit the function
(stop generation of reports)
       If (progressCancelStatus = True) Then
          rs.Close
          oConnection.Close
          subDoc.Close
          doc.Close
          GoTo ENDOFFUNC
       End If
   
       subDoc.Close

'VIJAY:        rs.MoveNext
       rs.MoveNext
   'repeat for the next testscript
   Loop
   
   'close the connections and the progress window
   rs.Close
   oConnection.Close
     
      If (rowCountFAIL = 3) Then
       tblFAIL.Cell(3, 1).Range.Text = "No Issues"
   End If
       doc.Save
   doc.Close
   
   DoCmd.Close acForm, "Progress Status"

   'Display message to user
   MsgBox "TestReports have been generated in : " & saveFolderPath

ENDOFFUNC:
   Set doc = Nothing
   Set appWord = Nothing
   Set subDoc = Nothing
   Exit Sub

the_error:
   MsgBox Err.Description
   doc.Close
   Set doc = Nothing
   Set appWord = Nothing
End Sub


'This functon prints the testcases & testevents into the sub report and
returns the status as to whether the Cancel button has been pressed or not.
Private Function CreateSubWordReport(subDoc As Word.Document,
strTestScriptName As String, lngTestScriptID As Long, oConnection As
ADODB.Connection) As Boolean
   
   Dim rng As Word.Range
   Dim rs1 As ADODB.Recordset
   Dim rs2 As ADODB.Recordset
   Dim tbl As Word.Table
   Dim expectedResultsFlag As Byte
   Dim rowCount As Long
   Dim testcaseCount As Long
   Dim eventCount As Integer
    Dim subtblFAIL As Word.Table
   Dim subrowCountFAIL As Long
   Dim subtblHWFAIL As Word.Table
   Dim subrowCountHWFAIL As Long
   Dim subtblSWFAIL As Word.Table
   Dim subrowCountSWFAIL As Long
   Dim subtblSpecFAIL As Word.Table
   Dim subrowCountSpecFAIL As Long
   Dim subtblBenchFAIL As Word.Table
   Dim subrowCountBenchFAIL As Long
   
   eventCount = 0
   testcaseCount = 0
   
   'Set up connecton to the SQL Server
   Dim oConnection_SQLserver As ADODB.Connection
   
   Set oConnection_SQLserver = New ADODB.Connection
   oConnection_SQLserver.ConnectionString = ConnectionString_SQLServer

   Set rs1 = New ADODB.Recordset
   Set rs2 = New ADODB.Recordset
   
   'Set rng equal to the range of the sub word report
   Set rng = subDoc.Range(Start:=0, End:=subDoc.Range.End)

   rng.SetRange subDoc.Range.End, subDoc.Range.End
   
   
   'Print the Issuesummary heading at the End of the document
   rng.InsertParagraphAfter
   rng.InsertParagraphAfter
   rng.SetRange rng.End, rng.End
   rng.Style = wdStyleHeading3
   rng.InsertAfter ("    " & "Issue Summary")
   
   rng.SetRange subDoc.Range.End, subDoc.Range.End
   rng.InsertParagraphAfter
   rng.InsertParagraphAfter
   rng.SetRange rng.End, rng.End
   
   'create a table to display the General Issues
   rng.Tables.Add Range:=rng, NumRows:=3, NumColumns:=2
   Set subtblFAIL = rng.Tables(1)
   subtblFAIL.Cell(1, 1).Range.Text = "General Issues"
   subtblFAIL.Cell(2, 1).Range.Text = "TestCase Name"
   subtblFAIL.Cell(2, 2).Range.Text = "Link to TestScript"
   subrowCountFAIL = 3
   
   rng.SetRange subDoc.Range.End, subDoc.Range.End
   rng.InsertParagraphAfter
   rng.InsertParagraphAfter
   rng.SetRange rng.End, rng.End
   
   'create a table to display the SW issues
   rng.Tables.Add Range:=rng, NumRows:=3, NumColumns:=2
   Set subtblSWFAIL = rng.Tables(1)
   subtblSWFAIL.Cell(1, 1).Range.Text = "Software Issues"
   subtblSWFAIL.Cell(2, 1).Range.Text = "TestCase Name"
   subtblSWFAIL.Cell(2, 2).Range.Text = "Link to TestScript"
   subrowCountSWFAIL = 3
   
   rng.SetRange subDoc.Range.End, subDoc.Range.End
   rng.InsertParagraphAfter
   rng.InsertParagraphAfter
   rng.SetRange rng.End, rng.End
   
   'create a table to display the HW issues
   rng.Tables.Add Range:=rng, NumRows:=3, NumColumns:=2
   Set subtblHWFAIL = rng.Tables(1)
   subtblHWFAIL.Cell(1, 1).Range.Text = "Hardware Issues"
   subtblHWFAIL.Cell(2, 1).Range.Text = "TestCase Name"
   subtblHWFAIL.Cell(2, 2).Range.Text = "Link to TestScript"
   subrowCountHWFAIL = 3
   
   rng.SetRange subDoc.Range.End, subDoc.Range.End
   rng.InsertParagraphAfter
   rng.InsertParagraphAfter
   rng.SetRange rng.End, rng.End
   
   'create a table to display the Spec issues
   rng.Tables.Add Range:=rng, NumRows:=3, NumColumns:=2
   Set subtblSpecFAIL = rng.Tables(1)
   subtblSpecFAIL.Cell(1, 1).Range.Text = "Specification Issues"
   subtblSpecFAIL.Cell(2, 1).Range.Text = "TestCase Name"
   subtblSpecFAIL.Cell(2, 2).Range.Text = "Link to TestScript"
   subrowCountSpecFAIL = 3
   
   rng.SetRange subDoc.Range.End, subDoc.Range.End
   rng.InsertParagraphAfter
   rng.InsertParagraphAfter
   rng.SetRange rng.End, rng.End
   
   'create a table to display the Bench Issues
   rng.Tables.Add Range:=rng, NumRows:=3, NumColumns:=2
   Set subtblBenchFAIL = rng.Tables(1)
   subtblBenchFAIL.Cell(1, 1).Range.Text = "Bench Tester Issues"
   subtblBenchFAIL.Cell(2, 1).Range.Text = "TestCase Name"
   subtblBenchFAIL.Cell(2, 2).Range.Text = "Link to TestScript"
   subrowCountFAIL = 3
   
   rng.SetRange subDoc.Range.End, subDoc.Range.End
   rng.InsertParagraphAfter
   rng.InsertParagraphAfter
   rng.SetRange rng.End, rng.End
   
   'Print the TestScriptName at the End of the document
   rng.InsertParagraphAfter
   rng.InsertParagraphAfter
   rng.SetRange rng.End, rng.End
   rng.Style = wdStyleHeading3
   rng.InsertAfter ("    " & "Test Cases")
   
   'Select all the testcases for the above testscript
   rs1.Open "SELECT TestCaseName, FinalStatus, TestCaseTime FROM
[Temp_Testcases] WHERE TestScriptID = " & lngTestScriptID & " ORDER BY
TestCaseTime", oConnection, adOpenStatic, adLockReadOnly
   'Repeat for all Testcases
   Do While (rs1.EOF = False)
       ActiveDocument.SpellingChecked = True
       ActiveDocument.GrammarChecked = True
       
       'Print the testcase name
       rng.InsertParagraphAfter
       rng.InsertParagraphAfter
       rng.SetRange rng.End, rng.End
       rng.Style = wdStyleHeading4
       rng.InsertBefore ("    " & rs1(0).Value)
       rng.InsertParagraphAfter
       rng.InsertParagraphAfter
       rng.SetRange rng.End, rng.End

       'Select all the Testevents belonging to the above testcase whose
logtype is not equal to 5
            oConnection_SQLserver.Open
       rs2.Open "SELECT logTime, logType, Comment1,Comment2,logStatus FROM
TestEvent WHERE TestScriptID = " & lngTestScriptID & " AND TestCaseTime = " &
rs1(2).Value & "  AND logType <> 5 ORDER BY logTime", oConnection_SQLserver,
adOpenStatic, adLockReadOnly
       
       If (rs2.EOF = True) Then
           GoTo ENDOFLOOP
       End If

       'Add a table to print the testevents.
       rng.Tables.Add Range:=rng, NumRows:=2, NumColumns:=3
       
       'enter the first row in the table
       Set tbl = rng.Tables(1)
       tbl.Cell(1, 1).Range.Text = "Action"
       tbl.Cell(1, 2).Range.Text = "Expected Results"
       tbl.Cell(1, 3).Range.Text = "Test Result"

       'expected Results flag is set to 1 on receiving a testevent with
logstatus equal to 1 or 3
       expectedResultsFlag = 0
       rowCount = 2
       
       'repeat for all testevents in each selected testcase
       Do While (rs2.EOF = False)
           
           'move to next row when expectedResultsFlag = 1
           If (expectedResultsFlag = 1 And (rs2.Fields(1) = 0 Or
rs2.Fields(1) = 2)) Then
               tbl.Rows.Add
               rowCount = rowCount + 1
               expectedResultsFlag = 0
           End If
           
           'format the color depending on whether the testevent is Pass or
Fail
           If (rs2.Fields(4) = 0) Then
               'case Fail
               tbl.Cell(rowCount, 1).Range.Font.Color = wdColorRed
               tbl.Cell(rowCount, 2).Range.Font.Color = wdColorRed
           Else
               'case Pass
               tbl.Cell(rowCount, 1).Range.Font.Color = wdColorBlack
               tbl.Cell(rowCount, 2).Range.Font.Color = wdColorBlack
           End If
           
           'Check the logstatus field
           If (rs2.Fields(1) = 0 Or rs2.Fields(1) = 2) Then
               'enter the testevent under the "Actions" column in the table
               tbl.Cell(rowCount, 1).Range.InsertAfter (rs2.Fields(2) & " "
& rs2.Fields(3))
               tbl.Cell(rowCount, 1).Range.InsertParagraphAfter
               tbl.Cell(rowCount, 1).Range.SetRange tbl.Cell(rowCount,
1).Range.End, tbl.Cell(rowCount, 1).Range.End
           ElseIf (rs2.Fields(1) = 1 Or rs2.Fields(1) = 3) Then
               'enter the testevent under the "Expected Results" column in
the table
               tbl.Cell(rowCount, 2).Range.InsertAfter (rs2.Fields(2) & " "
& rs2.Fields(3))
               tbl.Cell(rowCount, 2).Range.InsertParagraphAfter
               tbl.Cell(rowCount, 2).Range.SetRange tbl.Cell(rowCount,
2).Range.End, tbl.Cell(rowCount, 2).Range.End
               expectedResultsFlag = 1
           End If

           rs2.MoveNext
           
           'save the document from time to time
           eventCount = eventCount + 1
           If (eventCount > 1000) Then
               subDoc.Save
               eventCount = 0
           End If
           
           'transfer control to the OS
           DoEvents
                     
           'check if Cancel button has been pressed
           If (Forms![Progress Status].cmdProgressBar_Cancel.Value = True)
Then
               If (MsgBox("Do you want to stop the generation of WORD
reports ?", vbYesNo) = vbYes) Then
                   'close the progress window and exit the function
                   DoCmd.Close acForm, "Progress Status"
                   rs2.Close
                   rs1.Close
                   oConnection_SQLserver.Close
                   CreateSubWordReport = True
                   Exit Function
               End If
               Forms![Progress Status].cmdProgressBar_Cancel.Value = False
               Forms![Progress Status].lblCancelStatus.Visible = False
           End If

       Loop
       
       
       If (rowCount > 2) Then
           tbl.Cell(2, 3).Merge MergeTo:=tbl.Cell(rowCount, 3)
       End If
       tbl.Cell(1, 3).Range.InsertParagraphAfter
       tbl.Cell(1, 3).Range.InsertParagraphAfter
       
       'Check for the testcase being Pass or Fail
       If (rs1(1) = 2) Then
           tbl.Cell(2, 3).Range.InsertAfter ("PASS")
           tbl.Cell(2, 3).Range.Font.Color = wdColorBlack
       
       ElseIf (rs1(1) = 1) Then
           tbl.Cell(2, 3).Range.InsertAfter ("FAIL")
           tbl.Cell(2, 3).Range.Font.Color = wdColorRed
       
           'convert the TestScript name into an Hyperlink of the sub report
document
           tblFAIL.Cell(rowCountFAIL, 1).Range.Text = rs1(0)
           doc.Hyperlinks.Add Anchor:=tblFAIL.Cell(rowCountFAIL, 2).Range,
Address:=".\" & varTestScriptName & ".doc", TextToDisplay:=varTestScriptName
           tblFAIL.Cell(rowCountFAIL, 1).Range.InsertAfter vbCrLf
           tblFAIL.Rows.Add
           rowCountFAIL = rowCountFAIL + 1
           appWord.Visible = False
       
           'convert the TestScript name into an Hyperlink of the sub report
document
           subtblFAIL.Cell(subrowCountFAIL, 1).Range.Text = rs1(0)
           subDoc.Hyperlinks.Add Anchor:=subtblFAIL.Cell(subrowCountFAIL,
2).Range, Address:=".\" & varTestScriptName & ".doc",
TextToDisplay:=varTestScriptName
           subtblFAIL.Cell(subrowCountFAIL, 1).Range.InsertAfter vbCrLf
           subtblFAIL.Rows.Add
           subrowCountFAIL = subrowCountFAIL + 1
           appWord.Visible = False
       
       
       ElseIf (rs1(1) = 3) Then
           tbl.Cell(2, 3).Range.InsertAfter ("FAIL")
           tbl.Cell(2, 3).Range.Font.Color = wdColorRed
           
       
           'convert the TestScript name into an Hyperlink of the sub report
document
           tblFAIL.Cell(rowCountFAIL, 1).Range.Text = rs1(0)
           doc.Hyperlinks.Add Anchor:=tblFAIL.Cell(rowCountFAIL, 2).Range,
Address:=".\" & varTestScriptName & ".doc", TextToDisplay:=varTestScriptName
           tblFAIL.Cell(rowCountFAIL, 1).Range.InsertAfter vbCrLf
           tblFAIL.Rows.Add
           rowCountFAIL = rowCountFAIL + 1
           appWord.Visible = False
       
           'convert the TestScript name into an Hyperlink of the sub report
document
           subtblFAIL.Cell(subrowCountFAIL, 1).Range.Text = rs1(0)
           subDoc.Hyperlinks.Add Anchor:=subtblFAIL.Cell(subrowCountFAIL,
2).Range, Address:=".\" & varTestScriptName & ".doc",
TextToDisplay:=varTestScriptName
           subtblFAIL.Cell(subrowCountFAIL, 1).Range.InsertAfter vbCrLf
           subtblFAIL.Rows.Add
           subrowCountFAIL = subrowCountFAIL + 1
           appWord.Visible = False
       
       ElseIf (rs1(1) = 4) Then
           tbl.Cell(2, 3).Range.InsertAfter ("SW FAIL")
           tbl.Cell(2, 3).Range.Font.Color = wdColorRed
       
           'convert the TestScript name into an Hyperlink of the sub report
document
           tblSWFAIL.Cell(rowCountSWFAIL, 1).Range.Text = rs1(0)
           doc.Hyperlinks.Add Anchor:=tblSWFAIL.Cell(rowCountSWFAIL,
2).Range, Address:=".\" & varTestScriptName & ".doc",
TextToDisplay:=varTestScriptName
           tblSWFAIL.Cell(rowCountSWFAIL, 1).Range.InsertAfter vbCrLf
           tblSWFAIL.Rows.Add
           rowCountSWFAIL = rowCountSWFAIL + 1
           appWord.Visible = False
       
           'convert the TestScript name into an Hyperlink of the sub report
document
           subtblSWFAIL.Cell(subrowCountSWFAIL, 1).Range.Text = rs1(0)
           subDoc.Hyperlinks.Add
Anchor:=subtblSWFAIL.Cell(subrowCountSWFAIL, 2).Range, Address:=".\" &
varTestScriptName & ".doc", TextToDisplay:=varTestScriptName
           subtblSWFAIL.Cell(subrowCountSWFAIL, 1).Range.InsertAfter vbCrLf
           subtblSWFAIL.Rows.Add
           subrowCountSWFAIL = subrowCountSWFAIL + 1
           appWord.Visible = False
       
       ElseIf (rs1(1) = 5) Then
           tbl.Cell(2, 3).Range.InsertAfter ("HW FAIL")
           tbl.Cell(2, 3).Range.Font.Color = wdColorRed
       
           'convert the TestScript name into an Hyperlink of the sub report
document
           tblHWFAIL.Cell(rowCountHWFAIL, 1).Range.Text = rs1(0)
           doc.Hyperlinks.Add Anchor:=tblHWFAIL.Cell(rowCountHWFAIL,
2).Range, Address:=".\" & varTestScriptName & ".doc",
TextToDisplay:=varTestScriptName
           tblHWFAIL.Cell(rowCountHWFAIL, 1).Range.InsertAfter vbCrLf
           tblHWFAIL.Rows.Add
           rowCountHWFAIL = rowCountHWFAIL + 1
           appWord.Visible = False
       
           'convert the TestScript name into an Hyperlink of the sub report
document
           subtblHWFAIL.Cell(subrowCountHWFAIL, 1).Range.Text = rs1(0)
           subDoc.Hyperlinks.Add
Anchor:=subtblHWFAIL.Cell(subrowCountHWFAIL, 2).Range, Address:=".\" &
varTestScriptName & ".doc", TextToDisplay:=varTestScriptName
           subtblHWFAIL.Cell(subrowCountHWFAIL, 1).Range.InsertAfter vbCrLf
           subtblHWFAIL.Rows.Add
           subrowCountHWFAIL = subrowCountHWFAIL + 1
           appWord.Visible = False
       
       ElseIf (rs1(1) = 6) Then
           tbl.Cell(2, 3).Range.InsertAfter ("SPEC FAIL")
           tbl.Cell(2, 3).Range.Font.Color = wdColorRed
       
           'convert the TestScript name into an Hyperlink of the sub report
document
           tblSpecFAIL.Cell(rowCountSpecFAIL, 1).Range.Text = rs1(0)
           doc.Hyperlinks.Add Anchor:=tblSpecFAIL.Cell(rowCountSpecFAIL,
2).Range, Address:=".\" & varTestScriptName & ".doc",
TextToDisplay:=varTestScriptName
           tblSpecFAIL.Cell(rowCountSpecFAIL, 1).Range.InsertAfter vbCrLf
           tblSpecFAIL.Rows.Add
           rowCountSpecFAIL = rowCountSpecFAIL + 1
           appWord.Visible = False
       
           'convert the TestScript name into an Hyperlink of the sub report
document
           subtblSpecFAIL.Cell(subrowCountSpecFAIL, 1).Range.Text = rs1(0)
           subDoc.Hyperlinks.Add
Anchor:=subtblSpecFAIL.Cell(subrowCountSpecFAIL, 2).Range, Address:=".\" &
varTestScriptName & ".doc", TextToDisplay:=varTestScriptName
           subtblSpecFAIL.Cell(subrowCountSpecFAIL, 1).Range.InsertAfter
vbCrLf
           subtblSpecFAIL.Rows.Add
           subrowCountSpecFAIL = subrowCountSpecFAIL + 1
           appWord.Visible = False
       
       ElseIf (rs1(1) = 5) Then
           tbl.Cell(2, 3).Range.InsertAfter ("Bench Tester FAIL")
           tbl.Cell(2, 3).Range.Font.Color = wdColorRed
           If (responseBenchIssues = vbYes) Then
           
           'convert the TestScript name into an Hyperlink of the sub report
document
           tblBenchFAIL.Cell(rowCountBenchFAIL, 1).Range.Text = rs1(0)
           doc.Hyperlinks.Add Anchor:=tblBenchFAIL.Cell(rowCountBenchFAIL,
2).Range, Address:=".\" & varTestScriptName & ".doc",
TextToDisplay:=varTestScriptName
           tblBenchFAIL.Cell(rowCountBenchFAIL, 1).Range.InsertAfter vbCrLf
           tblBenchFAIL.Rows.Add
           rowCountBenchFAIL = rowCountBenchFAIL + 1
           appWord.Visible = False
       
           'convert the TestScript name into an Hyperlink of the sub report
document
           subtblBenchFAIL.Cell(subrowCountBenchFAIL, 1).Range.Text = rs1(0)
           subDoc.Hyperlinks.Add
Anchor:=subtblBenchFAIL.Cell(subrowCountBenchFAIL, 2).Range, Address:=".\" &
varTestScriptName & ".doc", TextToDisplay:=varTestScriptName
           subtblBenchFAIL.Cell(subrowCountBenchFAIL, 1).Range.InsertAfter
vbCrLf
           subtblBenchFAIL.Rows.Add
           subrowCountBenchFAIL = subrowCountBenchFAIL + 1
           appWord.Visible = False
           
           End If
       End If
       
       
       rng.SetRange tbl.Range.End, tbl.Range.End
       rng.InsertParagraphBefore
       rng.SetRange rng.End, rng.End
       
       'increment the testcase count
       testcaseCount = testcaseCount + 1
       
       Forms![Progress Status].ProgressBar.SetFocus

       'increment the progress bar depending on the percentage of testcases
added
       If (testcaseCount Mod 10 = 0) Then
           If (CSng((testcaseCount / rs1.recordCount) * 100) < 100) Then
               Forms![Progress Status].ProgressBar.Value =
CSng((testcaseCount / rs1.recordCount) * 100)
           Else
               Forms![Progress Status].ProgressBar.Value = 100
           End If
           Forms![Progress Status].Repaint
       End If

ENDOFLOOP:
       rs2.Close
       oConnection_SQLserver.Close
       rs1.MoveNext
             
   Loop
   
   rs1.Close
   
   For Each toc In ActiveDocument.TablesOfContents
       toc.Update
   Next
   
      End If
     
   subDoc.Save
   
   'Cancel has NOT been pressed in the progress window
   CreateSubWordReport = False
End Function
Jean-Guy Marcil - 22 May 2008 19:06 GMT
> hello i am using this code for generating word report, want to pause thise
> word report generation and resume when needed( may after the restarting the
> system)
> the entire code for generating word report i have pasted. The data are
> fetching from temp table created in Access.
> want to know how to pause these generation and resume when needed.

Hum, I do not really have time to look at all this code...

As a developer, you can do "CTRL-Break" to stop the macro. Then, in the VBA
window, continue the execution with F5.

If you want to create this for users... once a macro is started, it can't
really be stopped. I guess you could break down your code in smaller
routines. At the end of each routine, have a userform pop up askiing if
operation should continue, if so, call the next routine, if not, store where
you are at so that you can continue later...

There might be ways though to really make the macro pause, but I am not sure
that VBA offers such an option...

But more imnportantly, why do you feel you need this option?
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.