Tweak a SQL query for VB to match data

[emboughey]

The below code is pulling data from 2 files based on the planet code matching. Problem is one file has a 12 digit code and the other has an 11 digit code so no matches.

How would I tweak the below code to only look at 11 digits instead of 12? This is a large program and I'm thinking this is the area of code that needs to be changed.

Thanks in advance.


sql = "SELECT Planet_Code,Job_Number, Job_Name, format(Mail_Date,'00/00/0000')as Mail_Date , Qty_Mailed, facility_id as zip, date_time as [scan date], Op_code as opcodes,count(*) as [qty scanned] FROM " & USPS_FILE & Chr(44) & EMD_FILE & " WHERE [planet] = [Planet_Code] AND " & SearchCriteria & " GROUP BY Planet_Code,Job_Number, Job_Name, Mail_Date , Qty_Mailed, facility_id, date_time, Op_code order by Planet_Code, date_time

 

[SkipVought]

Hi,

Depending on the database you can use MID or SUBSTR...

WHERE Mid([planet],1,11) = [Planet_Code]

Skip,

_[red][/red]

 

[emboughey]

Skipvought.

It's still not pulling them. Below is all the code required for that specific form.

I hate to ask for help but I have tried several things and none have worked. They either pull only the planet codes in the archive with 11 digits and ignore the 12 digit ones or it just locks up and does nothing at all. (the archive and daily usps files are csv files so I'm not sure if the cell format is what is making the difference.)

Please help as this has ended up becoming an urgent issue.

thanks in advance.

****************


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

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 ReportSearchCriteria As String
Private SearchField As String

Private fsoUSPS As FileSystemObject

Private Sub Cancel_Click()

End Sub

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
lblSearching = "Searching, Please Wait"
TotalScans = 0
lblTotalScans = ""
IsBusy = True

mshfUspsData.Visible = False
mshfUspsData.Clear
Set mshfUspsData.DataSource = Nothing
Set recUSPS = Nothing
Set recEMD = Nothing

frmConfirmationData.Height = 7200
frmConfirmationData.Top = frm_emd.Top
DoEvents

If optDateRange Then
ReportSearchCriteria = "#" & DTPicker1(0).Value & "# AND #" & DTPicker1(1).Value & "#"
Else
ReportSearchCriteria = Trim(txtSearchCriteria)
End If

SetConnection
GetUSPSInformation ReportSearchCriteria, SearchField
CloseConnection

If recUSPS.RecordCount > 0 Then
recUSPS.MoveFirst

Do Until recUSPS.EOF
TotalScans = TotalScans + recUSPS("qty scanned").Value
recUSPS.MoveNext
Loop

Set mshfUspsData.DataSource = recUSPS
mshfUspsData.MergeCol(0) = True
mshfUspsData.ColWidth(0) = 1175
mshfUspsData.ColAlignment(0) = flexAlignCenterCenter

mshfUspsData.MergeCol(1) = True
mshfUspsData.ColWidth(1) = 1100
mshfUspsData.ColAlignment(1) = flexAlignCenterCenter

mshfUspsData.MergeCol(2) = True
If mshfUspsData.RowIsVisible(recUSPS.RecordCount) Then
mshfUspsData.ColWidth(2) = 2350
Else
mshfUspsData.ColWidth(2) = 2100
End If
mshfUspsData.ColAlignment(2) = flexAlignLeftCenter

mshfUspsData.MergeCol(3) = True
mshfUspsData.ColWidth(3) = 1150
mshfUspsData.ColAlignment(3) = flexAlignCenterCenter

mshfUspsData.MergeCol(4) = True
mshfUspsData.ColWidth(4) = 1100
mshfUspsData.ColAlignment(4) = flexAlignCenterCenter

mshfUspsData.ColWidth(5) = 875
mshfUspsData.ColAlignment(5) = flexAlignCenterCenter

mshfUspsData.ColWidth(6) = 1150
mshfUspsData.ColAlignment(6) = flexAlignCenterCenter

mshfUspsData.ColWidth(7) = 875
mshfUspsData.ColAlignment(7) = flexAlignCenterCenter

mshfUspsData.ColWidth(8) = 975
mshfUspsData.ColAlignment(8) = flexAlignRightCenter

mshfUspsData.Visible = True

lblTotalScans = "Total Scanned " & Format(TotalScans, "###,###,###,###")
cmdSaveReport.Enabled = True
Else
lblSearching = "NO RECORDS FOUND"
End If

IsBusy = False

Exit Sub
errHandler:
IsBusy = False
lblSearching = ""

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 Command1_Click()
Unload Me
End Sub

Private Sub Command2_Click()

End Sub

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

Private Sub Form_Unload(Cancel As Integer) 'ok
Set recUSPS = Nothing
Set recEMD = Nothing
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 (*.txt)|*.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
mnuImportNewDailyFile.Enabled = False
cmdReport.Enabled = False
cmdSaveReport.Enabled = False
optPlanetCode.Enabled = False
optJobNumber.Enabled = False
optDateRange.Enabled = False
DTPicker1(0).Enabled = False
DTPicker1(1).Enabled = False
DoEvents
Else
mnuImportNewDailyFile.Enabled = True
cmdReport.Enabled = True
'cmdSaveReport.Enabled = True
optPlanetCode.Enabled = True
optJobNumber.Enabled = True
optDateRange.Enabled = True
DTPicker1(0).Enabled = True
DTPicker1(1).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 recordset used in the report and writing the data to a file
Dim REPORT_FILE_Stream As TextStream
Dim JobNumberPrinted As String

If ReportFile = "" Then Exit Sub

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
If Not JobNumberPrinted = !Job_Number Then
REPORT_FILE_Stream.WriteLine
End If

REPORT_FILE_Stream.WriteLine !Job_Number & Chr(44) & !Job_Name & Chr(44) & !Mail_Date & Chr(44) & !Qty_Mailed & Chr(44) & _
!zip & Chr(44) & ![scan date] & Chr(44) & !opcodes & Chr(44) & ![qty scanned]
JobNumberPrinted = !Job_Number
.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(ByVal SearchCriteria As String, ByVal SearchField As String) 'ok
'this is querying for the data
On Error GoTo errHandler

Set recUSPS = New Recordset

Select Case SearchField
Case "Planet_Code", "Job_Number"
If SearchField = "Job_Number" Then
SearchField = "Planet_Code"
SearchCriteria = GetEmd_PlanetCode(SearchCriteria)
End If
SearchCriteria = SearchField & " = '" & SearchCriteria & "'"

Case "Date_Range"
SearchField = "cDate(date_time)"
SearchCriteria = SearchField & " BETWEEN " & SearchCriteria

End Select

sql = "SELECT Planet_Code,Job_Number, Job_Name, format(Mail_Date,'00/00/0000')as Mail_Date , Qty_Mailed, facility_id as zip, date_time as [scan date], Op_code as opcodes,count(*) as [qty scanned] FROM " & USPS_FILE & Chr(44) & EMD_FILE & " WHERE mid([planet],1,11) = mid([Planet_Code],1,11) AND " & SearchCriteria & " GROUP BY Planet_Code,Job_Number, Job_Name, Mail_Date , Qty_Mailed, facility_id, date_time, Op_code order by Planet_Code, 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 = -2147467259 Then
Resume
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_PlanetCode(JobNumber) As String 'ok
On Error GoTo errHandler
' this is querying for the the emd_archive file file, to match a planet code to a job number

Set recEMD = New Recordset

sql = "SELECT mid(Planet_Code,1,11) FROM " & EMD_FILE & " WHERE Job_Number = '" & JobNumber & "';"

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_PlanetCode = 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

Private Sub mshfUspsData_Click()

End Sub

Private Sub optDateRange_Click() 'ok
CheckOptions
End Sub

Private Sub optJobNumber_Click() 'ok
CheckOptions
End Sub

Private Sub optPlanetCode_Click() 'ok
CheckOptions
End Sub
Sub CheckOptions() 'ok

If optPlanetCode Then
SearchField = "Planet_Code"
txtSearchCriteria.Visible = True
DTPicker1(0).Visible = False
DTPicker1(1).Visible = False
lblFrom.Caption = "Planet / Job "
ElseIf optJobNumber Then
SearchField = "Job_Number"
txtSearchCriteria.Visible = True
DTPicker1(0).Visible = False
DTPicker1(1).Visible = False
lblFrom.Caption = "Planet / Job "
ElseIf optDateRange Then
SearchField = "Date_Range"
txtSearchCriteria.Visible = False
DTPicker1(0).Visible = True
DTPicker1(1).Visible = True
lblFrom.Caption = "FROM "
End If

End Sub

 

[SkipVought]

Here's a problem...

, format(Mail_Date,'00/00/0000') as Mail_Date

Should be...

, format(Mail_Date,'mm/dd/yyyy') as Mail_Date 
or
, format(Mail_Date,'dd/mm/yyyy') as Mail_Date 
or 
, format(Mail_Date,'yyyy/mm/dd') as Mail_Date

Then the Group By clause ALSO has to reflect this.

Fix that and try, cuz the mid criteria you have looks fine.


Skip,

_[red][/red]

 

[ArtieChoke]

There is no 'MID' function in SQL. You need to use SUBSTR.

"I think we're all Bozos on this bus!" - Firesign Theatre

 

[SkipVought]

Depends which application -- Access uses MID; other use SUBSTR. I already pointed out the choices.

Skip,

_[red][/red]

 

[ArtieChoke]

Access always gives me a headache - doh!

"I think we're all Bozos on this bus!" - Firesign Theatre