Empty record set error 1

[sparkbyte]

I have read a few examples on how to handle emty record sets but can't seem to be able to incorporate it into the Excel export.

Private Sub btnExporttoExcel_Click()
On Error GoTo err_Handler

'------------------------------------------------------
'------------------------------------------------------
' Export New Table to Excel
'------------------------------------------------------
'------------------------------------------------------
Dim strFileName As String
Dim strDateMin As String
Dim strDateMax As String

strDateMin = Format(DLookup("Min([TrackingDate])", "tblTrackingParse"), "mmddyy")
strDateMax = Format(DLookup("Max([TrackingDate])", "tblTrackingParse"), "mmddyy")


strPriority = InputBox("Enter the UPS Priority Number", "UPS Priority Number", "1")
   
  
strFileName = InputBox("Enter the Excel Spreadsheet File Name", "Enter File Name", "Initiated " & _
                strDateMin & " to " & strDateMax)
   
   
Dim rst As ADODB.Recordset
Dim cmd As ADODB.Command
Dim exAppWs As Worksheet
Dim rng As Excel.Range

Set cmd = New ADODB.Command

With cmd
    .ActiveConnection = CurrentProject.Connection
    .CommandType = adCmdText
    .CommandText = "SELECT BoxNumber, FileNumber, TrackingDate " & _
                    "FROM dbo.tblTrackingParse " & _
                    "WHERE (FileNumber <> '.box.end.') AND (BoxNumber NOT LIKE 'NBC%') " & _
                    "AND (LEN(BoxNumber) < '30') AND (TrackingNumberPrefix LIKE '1Z') " & _
                    "AND TrackingNumberShipping like '%" & strPriority & "%'"
End With

Set rst = cmd.Execute    ' now we have a recordset returned

Dim exCellApp As Excel.Application
Dim iCols As Integer
Set exCellApp = CreateObject("Excel.Application")
exCellApp.Visible = True
exCellApp.Workbooks.Add
For iCols = 0 To rst.Fields.Count - 1
    exCellApp.Worksheets(1).Cells(1, iCols + 1).Value = rst.Fields(iCols).Name
Next

exCellApp.Worksheets(1).Range("a2").CopyFromRecordset rst

exCellApp.Columns("C:C").Select
exCellApp.Selection.NumberFormat = "[$-409]d-mmm-yyyy;@"
exCellApp.Cells.Select
exCellApp.Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
exCellApp.Cells.EntireColumn.AutoFit
exCellApp.Range("A1").Select

'Debug.Print _
'               "O:\CentOps\Priroty Files Initiated\" & Year(Date) & "\" & strFileName & ".XLS"

exCellApp.ActiveWorkbook.SaveAs Filename:= _
                "O:\CentOps\Priroty Files Initiated\" & Year(Date) & "\" & strFileName & ".XLS", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
                CreateBackup:=False

'exCellApp.Workbooks.Close

exCellApp.Quit


rst.Close

endit:
Exit Sub

err_Handler:
    Select Case Err
        Case 2501
            'Do Nothing
        Case Else
            MsgBox _
            "An unexpected error has been detected" & Chr(13) & _
            "Error Number: " & Err.Number & " , " & Err.Description & Chr(13) & _
            vbCrLf & "Please note the above details before contacting support"
    End Select
Resume endit
End Sub

Thanks

John Fuhrman

 

[PHV]

how to handle emty record sets

...
Set rst = cmd.Execute    ' now we have a recordset returned
If rst.BOF And rst.EOF Then
  MsgBox "Nothing to export !"
  Exit Sub
End If
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[sparkbyte]

Another Star.

Figures I over analyzed the problem...

THANKS

Thanks

John Fuhrman