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?