Adding additional report to existing code

[emboughey]

Hi all,

I'm usually in Foxpro and not VB so please bear with me.

I have a form in VB that imports data and also creates a report if you enter a job # or planet code. I need another one that creates the exact same report by date range. (date range comes from the USPS daily file)

Can someone help me determine what areas to update?

Thanks in advance,

Elena


'added 03/09/07 all code is on this form

Option Explicit
Private conDATA As Connection
Private recUSPS As Recordset
Private recEMD As Recordset
Private Const USPS_FILE = "USPS_daily.csv"
Private Const EMD_FILE = "emd_Archive.csv"
Private sql As String
Private TotalScans As Long

Private fsoUSPS As FileSystemObject

Private Sub cmdReport_Click() 'ok
'this is the routine that is setting properties of controls and calling for the connection, report information and closing the connection , then displaying the data
On Error GoTo errHandler
Dim SearchCriteria As String
Dim SearchField As String

TotalScans = 0
lblTotalScans = ""
IsBusy = True

dgEmdData.Visible = False
dgUspsData.Visible = False

Set dgEmdData.DataSource = Nothing
Set dgUspsData.DataSource = Nothing

Set recUSPS = Nothing
Set recEMD = Nothing

frmConfirmationData.Height = 6750
frmConfirmationData.Top = frm_emd.Top
DoEvents
SearchCriteria = Trim(txtSearchCriteria)

If optPlanetCode Then
SearchField = "Planet_Code"
ElseIf optJobNumber Then
SearchField = "Job_Number"
End If

SetConnection
GetUSPSInformation GetEmd_ArchiveData(SearchCriteria, SearchField)
CloseConnection

If recUSPS.RecordCount > 0 Then
recUSPS.MoveFirst
Do Until recUSPS.EOF
TotalScans = TotalScans + recUSPS("qty scanned").Value
recUSPS.MoveNext
Loop
End If

Set dgEmdData.DataSource = recEMD
dgEmdData.Columns(0).Width = 1170
dgEmdData.Columns(0).Alignment = dbgCenter
dgEmdData.Columns(1).Width = 2340
dgEmdData.Columns(1).Alignment = dbgCenter
dgEmdData.Columns(2).Width = 1080
dgEmdData.Columns(2).Alignment = dbgCenter
dgEmdData.Columns(3).Width = 1170
dgEmdData.Columns(3).Alignment = dbgCenter
dgEmdData.Columns(4).Width = 1515
dgEmdData.Columns(4).Alignment = dbgCenter

Set dgUspsData.DataSource = recUSPS
dgUspsData.Columns(0).Width = 1740
dgUspsData.Columns(0).Alignment = dbgCenter
dgUspsData.Columns(1).Width = 1770
dgUspsData.Columns(1).Alignment = dbgCenter
If dgUspsData.VisibleRows < recUSPS.RecordCount Then
dgUspsData.Columns(2).Width = 1490
Else
dgUspsData.Columns(2).Width = 1740
End If
dgUspsData.Columns(2).Alignment = dbgCenter
dgUspsData.Columns(3).Width = 1000
dgUspsData.Columns(3).Alignment = dbgCenter
dgUspsData.Columns(4).Width = 1025
dgUspsData.Columns(4).Alignment = dbgCenter

dgEmdData.Visible = True
dgUspsData.Visible = True

IsBusy = False

If recUSPS.RecordCount > 0 Then
lblTotalScans = "Total Scanned " & Format(TotalScans, "###,###,###,###")
cmdSaveReport.Enabled = True
End If
Exit Sub
errHandler:
IsBusy = False

If Err.Number = 0 Then
'nothing here
Else
MsgBox "cmdReport-unexpected error has occurred" & vbNewLine & _
"error number : " & Err.Number & vbNewLine & _
"description : " & Err.Description, vbCritical, "ERROR"
End If

End Sub

Private Sub cmdSaveReport_Click() 'ok
'this is selecting a file name and calling the routine to write the data
On Error GoTo errHandler
Dim SelectedFile As String

IsBusy = True
SelectedFile = ""
With CommonDialog1
.CancelError = True
.InitDir = App.Path
.FileName = ""
.Filter = "comma delimited (*.csv)|*.csv"
.Flags = cdlOFNOverwritePrompt Or cdlOFNHideReadOnly
.ShowSave
SelectedFile = .FileName
End With

If Not SelectedFile = "" Then
SaveReport SelectedFile
cmdSaveReport.Enabled = True
End If

IsBusy = False

Exit Sub
errHandler:
IsBusy = False
If Err.Number = 32755 Then ' USER CANCELED
'nothing here
Else
MsgBox "cmdSaveReport-unexpected error has occurred" & vbNewLine & _
"error number : " & Err.Number & vbNewLine & _
"description : " & Err.Description, vbCritical, "ERROR"
End If

End Sub

Private Sub Form_Load() 'ok
frmConfirmationData.Height = 2500
DoEvents
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set recUSPS = Nothing
Set recEMD = Nothing
End Sub

Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub mnuImportNewDailyFile_Click() 'ok
'this is selecting file name and calling the routine to import confirmation data

On Error GoTo errHandler
Dim SelectedFile As String

IsBusy = True
SelectedFile = ""
With CommonDialog1
.DialogTitle = "Select File to Import"
.CancelError = True
.InitDir = App.Path
.FileName = ""
.Filter = "comma delimited (*.csv)|*.txt"
.Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly
.ShowOpen
SelectedFile = .FileName
End With

If Not SelectedFile = "" Then
USPSImport SelectedFile
End If
IsBusy = False

Exit Sub
errHandler:

IsBusy = False

If Err.Number = 32755 Then ' USER CANCELED
'nothing here
Else
MsgBox "mnuImportnewDailyFile-unexpected error has occurred" & vbNewLine & _
"error number : " & Err.Number & vbNewLine & _
"description : " & Err.Description, vbCritical, "ERROR"
End If
End Sub

Private Property Let IsBusy(busy As Boolean) 'ok
' this is enabling and disabling controls
If busy Then
cmdReport.Enabled = False
cmdSaveReport.Enabled = False
optJobNumber.Enabled = False
optPlanetCode.Enabled = False
mnuImportNewDailyFile.Enabled = False
DoEvents
Else
mnuImportNewDailyFile.Enabled = True
optPlanetCode.Enabled = True
optJobNumber.Enabled = True
'cmdSaveReport.Enabled = True
cmdReport.Enabled = True
DoEvents
End If

End Property


'*****************************************************************************************
'*****************************************************************************************
'*****************************************************************************************

Private Sub USPSImport(ImportFile As String) 'ok
' this is reading the new confirmation file, formatting the date and appending to the usps daily file
On Error GoTo errHandler

Dim USPS_FILE_Stream As TextStream
Dim IMPORT_FILE_Stream As TextStream
Dim ImportLine As String
Dim ImportElements() As String

If ImportFile = "" Then Exit Sub

Set fsoUSPS = New FileSystemObject
Set IMPORT_FILE_Stream = fsoUSPS.OpenTextFile(ImportFile, ForReading)

Set USPS_FILE_Stream = fsoUSPS.OpenTextFile(App.Path & "\" & USPS_FILE, ForAppending, True)

Do Until IMPORT_FILE_Stream.AtEndOfLine
ImportLine = IMPORT_FILE_Stream.ReadLine
ImportElements = Split(ImportLine, ",")
ImportElements(2) = Format(ImportElements(2), "mm/dd/yyyy")
ImportLine = Join(ImportElements, ",")
USPS_FILE_Stream.WriteLine ImportLine
Loop

USPS_FILE_Stream.Close
IMPORT_FILE_Stream.Close
Set USPS_FILE_Stream = Nothing
Set IMPORT_FILE_Stream = Nothing
Set fsoUSPS = Nothing

Exit Sub
errHandler:
If Err.Number = 0 Then
'nothing here
Else
MsgBox "USPSImport-unexpected error has occurred" & vbNewLine & _
"error number : " & Err.Number & vbNewLine & _
"description : " & Err.Description, vbCritical, "ERROR"
End If

End Sub

Private Sub SaveReport(ReportFile As String) 'ok
On Error GoTo errHandler
' this is getting the data from the recordsets used in the report and writing the data to a file
Dim REPORT_FILE_Stream As TextStream
Dim emdData As String

If ReportFile = "" Then Exit Sub

With recEMD
emdData = !Job_Number & Chr(44) & !Job_Name & Chr(44) & !Mail_Date & Chr(44) & !Qty_Mailed
End With

Set fsoUSPS = New FileSystemObject
Set REPORT_FILE_Stream = fsoUSPS.OpenTextFile(ReportFile, ForWriting, True)
REPORT_FILE_Stream.WriteLine "Job Number,Job Name,Mail Date,Mail Qty,SCF,Scan Date,Opcode,Qty Scan"

With recUSPS
.MoveFirst
Do Until .EOF
REPORT_FILE_Stream.WriteLine emdData & Chr(44) & !zip & Chr(44) & ![scan date] & Chr(44) & !opcodes & Chr(44) & ![qty scanned]
.MoveNext
Loop
End With

REPORT_FILE_Stream.Close
Set REPORT_FILE_Stream = Nothing
Set fsoUSPS = Nothing

Exit Sub
errHandler:
If Err.Number = 0 Then
'nothing here
Else
MsgBox "SaveReport-unexpected error has occurred" & vbNewLine & _
"error number : " & Err.Number & vbNewLine & _
"description : " & Err.Description, vbCritical, "ERROR"
End If

End Sub

Private Sub GetUSPSInformation(PlanetCode As String) 'ok
On Error GoTo errHandler
' this is querying for the data from the usps file, matching the planet code
Set recUSPS = New Recordset

sql = "SELECT planet, facility_id as zip, format(date_time,'mm/dd/yyyy') as [scan date], Op_code as opcodes,count(*) as [qty scanned] FROM " & USPS_FILE & " WHERE [planet] = '" & PlanetCode & "' GROUP BY planet, facility_id, date_time, Op_code order by date_time"

With recUSPS
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockReadOnly
Set .ActiveConnection = conDATA
.Open sql, , , , adCmdText
Set .ActiveConnection = Nothing
End With

Exit Sub
errHandler:
If Err.Number = 0 Then
'nothing here
Else
MsgBox "GetUSPSInformation-unexpected error has occurred" & vbNewLine & _
"error number : " & Err.Number & vbNewLine & _
"description : " & Err.Description, vbCritical, "ERROR"
End If

End Sub

Private Function GetEmd_ArchiveData(SearchCriteria, SearchField As String) As String 'ok
On Error GoTo errHandler
' this is querying for the data from the emd_archive file, matching the planet code or job number

Set recEMD = New Recordset

sql = "SELECT Job_Number, Job_Name, format(Mail_Date,'00/00/0000')as Mail_Date , Qty_Mailed, Planet_Code FROM " & EMD_FILE & " WHERE " & SearchField & " = '" & SearchCriteria & "';"

With recEMD
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockReadOnly
Set .ActiveConnection = conDATA
.Open sql, , , , adCmdText
Set .ActiveConnection = Nothing
End With

If Not recEMD.EOF Then
If Not IsNull(recEMD!Planet_Code) Then
If Not (recEMD!Planet_Code) = "" Then
GetEmd_ArchiveData = recEMD!Planet_Code
End If
End If
End If

Exit Function
errHandler:
If Err.Number = -2147467259 Then
Resume
Else
MsgBox "GetEmd_ArchiveData-unexpected error has occurred" & vbNewLine & _
"error number : " & Err.Number & vbNewLine & _
"description : " & Err.Description, vbCritical, "ERROR"
End If

End Function

Private Sub SetConnection() 'ok
On Error GoTo errHandler
' this is setting/opening the connection
Set conDATA = New Connection
With conDATA
.Provider = "Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "\;"
.Properties("Extended Properties").Value = "text;HDR=No;IMEX=1"
.Open
End With

Exit Sub
errHandler:
If Err.Number = 0 Then
'nothing here
Else
MsgBox "SetConnection-unexpected error has occurred" & vbNewLine & _
"error number : " & Err.Number & vbNewLine & _
"description : " & Err.Description, vbCritical, "ERROR"
End If

End Sub

Private Sub CloseConnection() 'ok
'this is closing the connection
On Error Resume Next
If conDATA Is Nothing Then Exit Sub
If Not conDATA.State = adStateClosed Then conDATA.Close
Set conDATA = Nothing
End Sub