Private Sub ExtractDataToText()
On Error GoTo ErrorHandler
'Declare the ADO objects variables
Dim objRsParent As ADODB.Recordset
Dim objRsChild As ADODB.Recordset
'Other variables
Dim strSQLQueryParent As String
Dim strSQLQueryChild As String
'' Dim g_strExportLogFileName As String
'Define the Log filename
g_strExportLogFileName = App.Path & "\" & Trim(GetINISetting(m_strINIFile, "ExecutionControl", "ExportDataFilename", "?"))
' Open the forward-only, read-only recordset
strSQLQueryParent = "select * from ACSRPT.FT1YLD_PRDOPR b " & _
"where exists(" & _
"select 1 from ACSRPT.FT1YLD_LOTLIST a " & _
"where a.WKSPRD = b.WKSPRD)"
Set objRsParent = New ADODB.Recordset
objRsParent.Open strSQLQueryParent, m_objConn, adOpenStatic, adLockReadOnly
strSQLQueryChild = "select WKSPRD, WKSLOT, OUTDTE, INPUT_, OUTPUT, REJECT, YIELD " & _
"from ACSRPT.FT1YLD_LOTLIST"
Set objRsChild = New ADODB.Recordset
objRsChild.Open strSQLQueryChild, m_objConn, adOpenStatic, adLockReadOnly
If Not objRsChild.BOF Then
'' MsgBox "Active Recordsets opened. Start writing data to text..."
Debug.Print "Active Recordsets opened. Start writing data to text..."
Open g_strExportLogFileName For Output As #1
'Write the header
Print #1, "**************************************** BOF ****************************************"
Print #1, "Production reported from : " & Format(Now - 2, "dd/mm/yyyy 23:00") & _
" to : " & Format(Now - 1, "dd/mm/yyyy 23:00")
Print #1, "Report run at : " & Format(Now, "dddd") & " " & Format(Now, "dd/mm/yyyy hh:mm")
Print #1, "====================================================================================="
'Write a blank line to the log file.
Print #1, ""
Debug.Print "Connected to the data source file."
Call LogEvent("Connected to the data source file.", "ExtractDataToText")
'' MsgBox "Writing file to " & g_strExportLogFileName
Debug.Print "Retrieving data from recordset..."
Call LogEvent("Retrieving data from recordset...", "ExtractDataToText")
Dim strParentRow As String
Dim strChildRow As String
Dim sDelimiter As String
sDelimiter = "| "
Dim i As Long, j As Integer ' i = row counter, j = column counter
Dim strProductFlag As String
i = 0
''MsgBox "Get product list..."
Debug.Print "Retrieving product list from recordset..."
' Write the data from recordset
Do While Not objRsParent.EOF
'' MsgBox objRsParent(0).Name
strParentRow = ""
For j = 0 To 3
strParentRow = strParentRow & objRsParent(j).Name & ": " & objRsParent(j).Value & sDelimiter
Next j
'Write new line
Print #1, strParentRow
strProductFlag = objRsParent(1)
objRsParent.MoveNext
'' Do While Not objRsChild.EOF
''MsgBox objRsChild(0) & " +++ " & strProductFlag
Print #1, "" 'write a new blank line
'' MsgBox "Get product details..."
Debug.Print "Retrieving product details from recordset..."
For j = 1 To 6
Print #1, objRsChild(j).Name & sDelimiter;
Next j
Print #1, "" 'write a new blank line
i = 0
'' Do While Not objRsChild.EOF ' Write the child data
Do While Not objRsChild.BOF ' Write the child data
If objRsChild(0) = strProductFlag Then
i = i + 1
For j = 1 To 6
Print #1, i & "|" & objRsChild(j).Value & sDelimiter & " "; ;
'' strChildRow = strChildRow & objRsChild(j).Value & sDelimiter
Next j
'' Print #1, strChildRow & " "; ;
Else
Print #1, vbCrLf
Exit Do
End If
objRsChild.MoveNext
Print #1, 'Write new line
Loop
i = i + 1
'' Exit Do
Print #1, "" 'write a new blank line
Loop
'write a new blank line
Print #1, ""
'write to new line
Print #1,
Close #1 ' Close the log file.
Else
MsgBox "Recordset has no data. Automation will not proceed. ", vbExclamation, "Automation Not Run"
End If
'' MsgBox "Complete loop"
Debug.Print "Report generation completed and the Text file was saved to disk."
Call LogEvent("Report generation completed and the Text file was saved to disk.", "ExtractDataToText")
'Close the objects
objRsParent.Close
objRsChild.Close
'' m_objConn.Close
'Release the memory associated with the objects
Set objRsParent = Nothing
Set objRsChild = Nothing
'' Set m_objConn = Nothing
Call LogEvent("Close the data source connection and release ADO objects.", "ExtractDataToText")
Exit Sub
ErrorHandler:
''Resume Next
Call LogError(Me.Name, "ExtractDataToText", Err.Number, Err.Description)
End Sub
