locked
MS Word report failures in VB6 application - Please advise me RRS feed

  • Question

  •  

    Hi,
     
      We have an VB 6 application component that is generating MS word document (2003).We have this application running in three different environments Dev,QC and Production.Currently we are experiencing WORD document failures in live(prod) environment.Here is the detailed error description:
     
     
    The component is IRISQueue.exe
    The Request Id is 0.
    The error number is 5273 and the description is The document name or path is not valid.
    Try one or more of the following:
    * Check the path to make sure it was typed correctly.
    * On the File menu, click Open. Search for the file using this dialog box.
     (
    http://.../default.asp).
     
    Am also providing code of IRISQueue.exe for your reference.Please have a look and let me know what could be done to get rid of this issue.I would appreciate if you get me quick solution to fix this.Awaiting for your response.
     
     
     
    Here is the complete code:
     
    Private Const IRIS_REG_ROOT = "HKEY_LOCAL_MACHINE\SOFTWARE\NASDR\IRIS"
    Private Const MACHINE_ROOT = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName"
    Private gWord As Word.Application
    Private gDocument As Word.Document
    Private gWebDocument As Word.Document
    Private gRootURL As String
    Private gUNCPath As String
    Private gWorkDirRoot As String
    Private gFirstPage As Boolean
    Private tRegIF As New NTALite.ntRegIF
    '************************************************************************************/
    'Change History
    '------------------------------------------------------------------------------------/
    'Number     Done By     Date            SCR No.     Description
    '------------------------------------------------------------------------------------/
    '001        TCS     10/01/2001          38850         Connection method changed from ODBC to OLEDB
    '002        TCS     10/01/2001          38850         Report Log generated to log events
    '
    '===================================================================
    ' Who : Carl Doerflinger
    ' When: 03/03/2005
    ' SCR#: 78382
    ' Desc: Updated to MDAC 2.8.  Added close statements in error handler
    ' for word.
    '===================================================================

    Sub Main()
        If App.PrevInstance Then
            Exit Sub
        Else
            procAllProfiles
        End If
    End Sub
    Public Sub procAllProfiles()
        Dim tProfiles As Variant
        Dim tProfCount As Integer
       
        tProfiles = tRegIF.GetKeyList(IRIS_REG_ROOT & "\Profiles")
       
        If IsArray(tProfiles) Then
            For tProfCount = 0 To UBound(tProfiles)
                If tProfiles(tProfCount) <> "" Then
                    procProfile tProfiles(tProfCount)
                End If
            Next
        End If
    End Sub
    Private Sub procProfile(ByVal tProfile As String)
    '===================================================================
    '                       Update History
    '===================================================================
    ' Who : Carl Doerflinger
    ' When: 03/03/2005
    ' SCR#: 78387
    ' Desc: Modified code to use directory path name instead of UNC
    '       for file manipulation but use UNC for email message.
    '       Fix code so error log was not hard coded.
    '===================================================================
    ' Who : Carl Doerflinger
    ' When: 03/11/2005
    ' SCR#: 78387
    ' Desc: Add server name to the select so that the job can run on
    '       multiple machines at the same time.
    ' ------------------------------------------------------------------
    ' Who : Jawahardeen Abdulkareem
    ' When: 05/14/2007
    ' CR# 21667
    ' Description: Email Notification Logic expanded to send email to other email
    '    addresses other than @nasd.com email address.
    '===================================================================
    ' Who : Jawahardeen Abdulkareem
    ' When: 05/14/2007
    ' CR # 21,569
    ' Description: WinWord CPU Utilization issue. To fix this issue the hanging WinWord.exe
    ' process is killed once the Job completed successful or Failed
    '===================================================================
        Dim tRegVal As Variant
        Dim tComputer As String
        Dim tDSN As String
        Dim tUID As String
        Dim tPWD As String
        Dim tConn As adodb.Connection
        Dim tRS As adodb.Recordset
        Dim tScr As adodb.Recordset
        Dim tOrg As adodb.Recordset
        Dim tTime As Date
        Dim tWorkDir As String
        Dim tWorkFile As String
        Dim tUNCPath As String
        Dim tRequestID As Long
        Dim tUserID As String
        Dim tPos As Long
        Dim tURL As String
        Dim tDBSource As String
        'CR# 21667
        Dim tUserEmail As String
       
        On Error GoTo ErrHndlr
       
        tRegVal = tRegIF.GetValue(IRIS_REG_ROOT & "\Profiles\" & tProfile, "BRURL")
        If Not IsNull(tRegVal) Then
            gRootURL = "http://" & tRegVal
            If Right(gRootURL, 1) <> "/" Then
                gRootURL = gRootURL & "/"
            End If
        End If
       
        tRegVal = tRegIF.GetValue(IRIS_REG_ROOT & "\Profiles\" & tProfile, "BRPATH")
        If Not IsNull(tRegVal) Then
            gWorkDirRoot = tRegVal
            If gWorkDirRoot <> "" Then
                If Right(gWorkDirRoot, 1) <> "\" Then
                    gWorkDirRoot = gWorkDirRoot & "\"
                End If
            End If
        End If
       
        If gWorkDirRoot = "" Then
            'Close #1
            Exit Sub
        End If
       
        tRegVal = tRegIF.GetValue(IRIS_REG_ROOT & "\Profiles\" & tProfile, "BRUNC")
        If Not IsNull(tRegVal) Then
            gUNCPath = tRegVal
            If gUNCPath <> "" Then
                If Right(gUNCPath, 1) <> "\" Then
                    gUNCPath = gUNCPath & "\"
                End If
            End If
        End If
       
        tComputer = tRegIF.GetValue(MACHINE_ROOT, "ComputerName")
        '001 - Start
       
        tDBSource = tRegIF.GetValue(IRIS_REG_ROOT & "\Profiles\" & tProfile, "DB SOURCE")
        If IsNull(tDBSource) Then
            tDBSource = ""
        End If
        tUID = tRegIF.GetValue(IRIS_REG_ROOT & "\Profiles\" & tProfile, "UID")
        If IsNull(tUID) Then
            tUID = ""
        End If
        tPWD = tRegIF.GetValue(IRIS_REG_ROOT & "\Profiles\" & tProfile, "PWD")
        If IsNull(tPWD) Then
            tPWD = ""
        End If
        tConnString = "Provider=MSDAORA.1;Password=" & tPWD & ";User ID=" & tUID & ";Data Source=" & tDBSource & ";Persist Security Info=True"
        '001 - End
       
        Set tConn = New adodb.Connection
        Set tRS = New adodb.Recordset
        tConn.Open tConnString
       tRS.CursorLocation = adUseClient
        ' CR# 21667 - USER_EMAIL column added to the select
        tRS.Open "SELECT BATCH_PRNT_RQST.*,USER_NTWRK_LOGON,USER_EMAIL FROM BATCH_PRNT_RQST," & _
                 "IRIS_USER WHERE RQST_ST = 'USER SUBMIT' AND MODE_NM <> 'DOC BATCH' " & _
                 "AND RQSTR_USER_ID = USER_ID " & _
                 "AND UPPER(SRVR_NM) = '" & tComputer & "' " & _
                 "ORDER BY RQST_ST,RQST_ID", tConn, adOpenStatic, adLockBatchOptimistic
        If tRS.RecordCount > 0 Then
            Set gWord = New Word.Application
            Set gWebDocument = gWord.Documents.Open(FileName:=gRootURL & "default.asp", _
                ConfirmConversions:=False, ReadOnly:=True, AddToRecentFiles:=False, _
                PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
                wdOpenFormatWebPages)
            gWebDocument.Close
            Set gWebDocument = gWord.Documents.Open(FileName:=gRootURL & "loadsession.asp", _
                ConfirmConversions:=False, ReadOnly:=True, AddToRecentFiles:=False, _
                PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
                wdOpenFormatWebPages)
            gWebDocument.Close
            Set gWebDocument = gWord.Documents.Open(FileName:=gRootURL & "mainmenu.asp?reportmode=YES", _
                ConfirmConversions:=False, ReadOnly:=True, AddToRecentFiles:=False, _
                PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
                wdOpenFormatWebPages)
            gWebDocument.Close
            Set gWebDocument = Nothing
           
            Set tScr = New adodb.Recordset
            Set tOrg = New adodb.Recordset
            tScr.CursorLocation = adUseClient
            tOrg.CursorLocation = adUseClient
            Do While Not tRS.EOF
                tRequestID = CLng(tRS.Fields("RQST_ID").Value)
                tConn.Execute "UPDATE BATCH_PRNT_RQST SET RQST_ST = 'IN QUEUE',RQST_ST_DT = SYSDATE WHERE RQST_ID = " & CStr(tRequestID)
                tScr.Open "SELECT SCRN_NM,SCRN_GRP_NM,MODE_NM FROM BATCH_PRNT_RQST_SCRN,VIEW_SCRN WHERE RQST_ID = " & CStr(tRequestID) & " AND UPPER(VIEW_SCRN.MODE_NM) = '" & tRS("MODE_NM") & "' AND BATCH_PRNT_RQST_SCRN.SCRN_ID = VIEW_SCRN.SCRN_ID ORDER BY MODE_PSTN_NB,SCRN_GRP_PSTN_NB,SCRN_PSTN_NB", tConn, adOpenStatic, adLockBatchOptimistic
                tOrg.Open "SELECT * FROM BATCH_PRNT_RQST_MBR WHERE RQST_ID = " & CStr(tRequestID) & " AND RQST_MBR_ST IS NULL ORDER BY RQST_MBR_SORT_NB", tConn, adOpenStatic, adLockBatchOptimistic
                If tScr.RecordCount > 0 And tOrg.RecordCount > 0 Then
                    tUserID = tRS.Fields("USER_NTWRK_LOGON").Value
                    tPos = InStr(tUserID, "\")
                    If tPos > 0 Then
                        tUserID = Right(tUserID, Len(tUserID) - tPos)
                    End If
                    tWorkDir = gWorkDirRoot & tUserID
                    tUNCPath = gUNCPath & tUserID
                    If Dir(tWorkDir, vbDirectory) = "" Then
                        MkDir tWorkDir
                    End If
                    tWorkDir = tWorkDir & "\" & CStr(tRequestID)
                    If Dir(tWorkDir, vbDirectory) = "" Then
                        MkDir tWorkDir
                    End If
                    Do While Not tOrg.EOF
                        Set gDocument = gWord.Documents.Add
                        gDocument.PageSetup.Orientation = wdOrientLandscape
                        gFirstPage = True
                        tWorkFile = tWorkDir & "\" & CStr(tOrg("RQST_MBR_ORG_ID")) & ".DOC"
                        tScr.MoveFirst
                        Do While Not tScr.EOF
                            tURL = gRootURL & "loadform.asp?mode=" & ReplaceString(tScr.Fields("MODE_NM").Value, " ", "+") & _
                                "&screengroup=" & ReplaceString(tScr.Fields("SCRN_GRP_NM").Value, " ", "+") & _
                                "&screen=" & ReplaceString(tScr.Fields("SCRN_NM").Value, " ", "+")
                            Select Case UCase(tScr.Fields("MODE_NM").Value)
                            Case "FIRM PROFILE", "RISK PROFILE"
                                tURL = tURL & "&mbr_org_id=" & CStr(tOrg.Fields("RQST_MBR_ORG_ID").Value)
                                If Not IsNull(tRS.Fields("PARM_FILE_RUN_ID").Value) Then
                                    tURL = tURL & "&parm_file_run_id=" & CStr(tRS.Fields("PARM_FILE_RUN_ID").Value)
                                End If
                            Case "INDIVIDUAL PROFILE"
                                tURL = tURL & "&indvl_id=" & CStr(tOrg.Fields("RQST_MBR_ORG_ID").Value)
                            Case "DISTRICT RISK PROFILE"
                                tURL = tURL & "&parm_file_run_id=" & CStr(tOrg.Fields("RQST_MBR_ORG_ID").Value)
                            End Select
                            getHTMLfromURL tURL, tWorkFile
                            tScr.MoveNext
                        Loop
                        gDocument.Activate
                        gWord.ActiveWindow.ActivePane.View.ShowAll = True
                        gWord.Selection.Find.ClearFormatting
                        gWord.Selection.Find.Replacement.ClearFormatting
                        With gWord.Selection.Find
                            .Text = "^d"
                            .Replacement.Text = ""
                            .Forward = True
                            .Wrap = wdFindContinue
                            .Format = False
                            .MatchCase = False
                            .MatchWholeWord = False
                            .MatchWildcards = False
                            .MatchSoundsLike = False
                            .MatchAllWordForms = False
                        End With
                        gWord.Selection.Find.Execute Replace:=wdReplaceAll
                        gDocument.Save
                        gDocument.SaveAs FileName:=tWorkFile, FileFormat:=wdFormatRTF, LockComments _
                            :=False, Password:="", AddToRecentFiles:=False, WritePassword:="", _
                            ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
                            SaveNativePictureFormat:=True, SaveFormsData:=False, SaveAsAOCELetter:= _
                            False
                        gDocument.Close
                        Set gDocument = Nothing
                       tConn.Execute "UPDATE BATCH_PRNT_RQST_MBR SET RQST_MBR_ST = 'COMPLETE',RQST_MBR_ST_DT = SYSDATE WHERE RQST_ID = " & CStr(tRequestID) & " AND RQST_MBR_ORG_ID = " & CStr(tOrg.Fields("RQST_MBR_ORG_ID").Value)
                       tOrg.MoveNext
                    Loop
                    App.LogEvent "Batch Report Engine: Process complete for request " & CStr(tRequestID), 4
                   
                    Dim tNewMail As New SimpleMail.smMail
                    tMessage = "Your Batch Report has completed.  Please follow the instructions below to download your report." & vbCrLf & vbCrLf & _
                        "Click on the link below to access the report:" & vbCrLf & _
                        "    " & tUNCPath & vbCrLf & vbCrLf & _
                        "Each report file has all requested screens for an individual firm.  The file names are representative of the firm's CRD number."
                   
                    'CR# 21667 - Check if any email-id is given.
                    If Not IsNull(tRS.Fields("USER_EMAIL").Value) Or (tRS.Fields("USER_EMAIL").Value = "") Then
                        tUserEmail = tRS.Fields("USER_EMAIL").Value
                        tNewMail.MailTo = tUserEmail
                    Else
                        tNewMail.MailTo = tUserID & "@nasd.com"
                    End If
                    ' CR# 21667 - Logic Ends
                   
                    tNewMail.MailFrom = "IRIS.Batch.Reports@nasd.com"
                    tNewMail.Subject = "IRIS: Batch Report Complete"
                    tNewMail.Body = tMessage
                    tNewMail.MailServer = "mailhub.rkv.nasd.com"
                   
                    tNewMail.Send
                    Set tNewMail = Nothing
                Else
                    App.LogEvent "Batch Report Engine: Nothing to process on request " & CStr(tRequestID), 2
                End If
                tConn.Execute "UPDATE BATCH_PRNT_RQST SET RQST_ST = 'COMPLETE',RQST_ST_DT = SYSDATE WHERE RQST_ID = " & CStr(tRequestID)
                tRS.MoveNext
                tScr.Close
                tOrg.Close
            Loop
            Set tScr = Nothing
            Set tOrg = Nothing
            gWord.Quit
            Set gWord = Nothing
            'CR # 21,569 - The hanging WinWord.exe is killed after the job is complete
            Shell gWorkDirRoot & "TASKKILL.bat"
           
        End If
        tRS.Close
        tConn.Close
        Set tRS = Nothing
        Set tConn = Nothing
        Exit Sub
    '002 - Start
    ErrHndlr:
        Open gWorkDirRoot & "ReportLog.txt" For Append As #2
        Print #2, vbCrLf & vbCrLf
        Print #2, "A Report submitted by " & tUserID & " has failed at " & Now & "."
        Print #2, "The component is IRISQueue.exe"
        Print #2, "The Request Id is " & tRequestID & "."
        Print #2, "The error number is " & Err.Number & " and the description is " & Err.Description & "."
        Print #2, "*************************Log Boundary*************************"
        Close #2
       
        On Error Resume Next
       
        If Not IsNull(gWebDocument) Then
            gWebDocument.Close
            Set gWebDocument = Nothing
        End If
       
        If Not IsNull(gDocument) Then
            gDocument.Close
            Set gDocument = Nothing
        End If
       
        If Not IsNull(gWord) Then
            gWord.Quit
            Set gWord = Nothing
            'CR # 21,569 - The hanging WinWord.exe is killed during  job failure
            Shell gWorkDirRoot & "TASKKILL.bat"
        End If
       
        If Not IsNull(tRS) Then
            tRS.Close
            Set tRS = Nothing
        End If
       
        If Not IsNull(tConn) Then
            If tConn.State <> adodb.adStateClosed Then
                    tConn.Execute "DELETE BATCH_PRNT_RQST WHERE RQST_ID = " & CStr(tRequestID)
                    tConn.Close
            End If
            Set tConn = Nothing
        End If
    '002 - End
    End Sub
    Sub getHTMLfromURL(ByVal pURL As String, ByVal pDocFileName As String)
        Dim tRetryCount As Long
        Dim tRetry As Boolean
        tTryCount = 0
        On Error GoTo RetryPage
       
        Do
            tRetry = False
            Set gWebDocument = gWord.Documents.Open(FileName:=pURL, _
                ConfirmConversions:=False, ReadOnly:=True, AddToRecentFiles:=False, _
                PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
                wdOpenFormatWebPages)
            tTryCount = tTryCount + 1
            If tRetry Then
                gWebDocument.Close False
                Set gWebDocument = Nothing
            End If
        Loop Until (Not tRetry) Or tTryCount >= 5
        gWebDocument.Activate
        gWord.Selection.WholeStory
        gWord.Selection.Copy
        gDocument.Activate
        If Not gFirstPage Then
            gWord.Selection.EndKey Unit:=wdStory
            gWord.Selection.InsertBreak Type:=wdPageBreak
        Else
            gFirstPage = False
        End If
        gWord.Selection.EndKey Unit:=wdStory
        gWord.Selection.Paste
        gDocument.SaveAs FileName:=pDocFileName, FileFormat:=wdFormatRTF, LockComments _
            :=False, Password:="", AddToRecentFiles:=False, WritePassword:="", _
            ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
            SaveNativePictureFormat:=True, SaveFormsData:=False, SaveAsAOCELetter:= _
            False
        gWebDocument.Close False
        Set gWebDocument = Nothing
        Exit Sub
    RetryPage:
        tRetry = True
        Resume Next
    End Sub
    Public Function ReplaceString(ByVal pString As String, ByVal pSearch As String, ByVal pReplace As String) As String
        Dim tPos As Long
        tPos = 1
        Do
            tPos = InStr(tPos, pString, pSearch)
            If tPos > 0 Then
                pString = Left(pString, tPos - 1) & pReplace & Right(pString, Len(pString) - tPos)
                tPos = tPos + Len(pReplace)
            End If
        Loop Until tPos <= 0
        ReplaceString = pString
    End Function
     
     
    Thanks,
    Vishnu
    Wednesday, September 3, 2008 3:58 PM