Printable View
I have an error message show when this line of code executes.
The error message is:Code:CrystalActiveXReportViewer1.ReportSource = Report
CrystalActiveXReportViewer1.ViewReport
Any ideas?Code:Logon Failed
Details: ADO Error Code: 0x80004005
Source: Microsoft OLE DB Provider for ODBC Drivers
Description: [Microsoft][ODBC Driver Manager] Data Source name not found and default driver specified
SQL State: IM002
This was working last week.
What changed between now and last week?
Code just doesn't stop working because it wants to.
I have not made changes in the last week to this project. It looks like the sql server is running, could there be something wrong there?
Are you sure that the DSN used in that report, exists in the client pc?
I have to check the DSN connection.
How can I tell from someone else's code what the DSN should be.
I am trying to fix some errors on this older code, and if I can't even get the
reports to open then there is no hope.....
Here is the whole sub (code)
Code:
Private Sub PrintCheckList()
On Error GoTo ErrHand
Dim rsGetKitInfo As ADODB.Recordset
Dim rsGetLineItems As ADODB.Recordset
Dim rsGetItemInfo As ADODB.Recordset
Dim DB As New ADODB.Connection
Dim intCounter As Integer
Dim intKit As Integer
Dim rsDelete As ADODB.Recordset
Dim rsInsert As ADODB.Recordset
' Dim statements for Report 06/18/04 JE
Dim strSelectionFormula As String
Dim SQL As String
Dim adoRs As ADODB.Recordset
Dim rsCheck As ADODB.Recordset
Dim rsRecordCount As ADODB.Recordset
If UpdateFlag = True Then SaveItem
Screen.MousePointer = vbHourglass
DB.Open "Driver=SQL Server;Server=" & gblDatabase2 & ";Database=" & gblDatabase1 & ";Trusted_Connection=yes;"
grdLineItem.Update
'clearing out the temp table.
SQL = "DELETE FROM CheckListReportTemp"
Set rsDelete = New ADODB.Recordset
rsDelete.Open SQL, DB, adOpenDynamic, adLockOptimistic
intCounter = 1
' This SQL statement solves the problem when there are more then one of the same kitid's in the grid JE 05/01/03
' SQL = "SELECT LineItemTable.ContractNumber, LineItemTable.ItemNum, LineItemTable.QtyRentSold, " & _
' "LineItemTable.Description FROM LineItemTable LEFT JOIN KitItemsTable ON LineItemTable.ItemNum = KitItemsTable.KitNum " & _
' "GROUP BY LineItemTable.ContractNumber, LineItemTable.ItemNum, LineItemTable.QtyRentSold, LineItemTable.Description " & _
' "HAVING (((LineItemTable.ContractNumber)=" & txtDocNo & "));"
SQL = "SELECT LineItemTable.ContractNumber, LineItemTable.ItemNum, LineItemTable.Description, " & _
"SUM(LineItemTable.QtyRentSold) AS QtyRentSold From LineItemTable " & _
"GROUP BY LineItemTable.ContractNumber, LineItemTable.ItemNum, LineItemTable.Description " & _
"HAVING (((LineItemTable.ContractNumber)=" & txtDocNo & "));"
' SQL1 = "SELECT * LineItemTable FROM LineItemTable WHERE LineItemTable.ContractNumber = " & txtDocNo & ""
' Removed description from qry. The grouping of description caused the checklist to double the qyt rented. 05/16/03 JE
' SQL = "SELECT LineItemTable.ContractNumber, Sum(LineItemTable.QtyRentSold) AS QtyRentSold, " & _
' "LineItemTable.ItemNum From LineItemTable GROUP BY LineItemTable.ContractNumber, LineItemTable.ItemNum " & _
' "HAVING (((LineItemTable.ContractNumber)= " & txtDocNo & "));"
Set rsGetLineItems = New ADODB.Recordset
rsGetLineItems.Open SQL, DB, adOpenKeyset, adLockOptimistic
' Set rsRecordCount = New ADODB.Recordset
' rsRecordCount.Open SQL1, DB, adOpenKeyset, adLockBatchOptimistic
If rsGetLineItems.EOF Then
MsgBox "Invalid Contract Number.", vbExclamation, "Invalid"
rsGetLineItems.Close
Set rsGetLineItems = Nothing
Exit Sub
End If
rsGetLineItems.MoveLast: rsGetLineItems.MoveFirst
'loop through all the records returned and save them to a temp table.
For intCounter = 1 To rsGetLineItems.RecordCount
'seeing if the kit has been modified. Must compare the Item Id to the Kit # AND the contract # AaronD 2/10/01
SQL = "SELECT * FROM ContractKitItems WHERE KitNum = '" & rsGetLineItems![ItemNum] & "' AND ContractNumber = " & txtDocNo & ""
Set rsGetKitInfo = New ADODB.Recordset
rsGetKitInfo.Open SQL, DB, adOpenKeyset, adLockOptimistic
QtyRentSold = rsGetLineItems![QtyRentSold]
If rsGetKitInfo.EOF Then
'seeing if it is a regular, unmodified kit. AaronD 2/10/01
SQL = "SELECT * FROM KitItemsTable WHERE KitNum = '" & rsGetLineItems![ItemNum] & "'"
Set rsGetKitInfo = New ADODB.Recordset
rsGetKitInfo.Open SQL, DB, adOpenDynamic, adLockOptimistic
If Not rsGetKitInfo.EOF Then
'if its a kit item then save the item info for all the parts in the kit into a temp table.
If frmPickTicket.SaveKitItems(rsGetKitInfo, txtDocNo, rsGetLineItems![QtyRentSold]) = False Then Exit Sub
Else
'if its not a kit item then save the item info in the temp table.
If frmPickTicket.SaveItemInfo(rsGetLineItems) = False Then Exit Sub
End If
Else
'if its a kit item then save the item info for all the parts from ContractKitItems in the kit into a temp table.
If frmPickTicket.SaveKitItems(rsGetKitInfo, txtDocNo, rsGetKitInfo![QtyofItem]) = False Then Exit Sub
End If
rsGetKitInfo.Close: Set rsGetKitInfo = Nothing
rsGetLineItems.MoveNext
Next intCounter
' SQL statement insert query from AddToItem table Items add to kit on the fly 05/06/03 JE
SQL = "INSERT INTO ChecklistReportTemp ( ItemNum, Description, Qty, ContractNumber ) SELECT AddToKit.ItemNum, AddToKit.ItemDesc, AddToKit.QtyofItem, AddToKit.ContractNumber From AddToKit WHERE (((AddToKit.ContractNumber)= " & txtDocNo & "))"
Set rsInsert = New ADODB.Recordset
rsInsert.Open SQL, DB, adOpenDynamic, adLockOptimistic
' rsInsert.Close
Set rsInsert = Nothing
' SQL statement insert inventory id's that are kits to create a kit 04/20/03 JE
SQL = "INSERT INTO ChecklistReportTemp ( ContractNumber, Catagory, Description, ItemNum, Qty )SELECT ChecklistReportTemp.ContractNumber, ChecklistReportTemp.Catagory, KitItemsTable.ItemDesc, KitItemsTable.ItemNum, (KitItemsTable.QtyOfItem) AS Qty FROM ChecklistReportTemp INNER JOIN KitItemsTable ON ChecklistReportTemp.ItemNum = KitItemsTable.KitNum;"
' Debug.Print SQL
Set rsInsert = New ADODB.Recordset
rsInsert.Open SQL, DB, adOpenDynamic, adLockOptimistic
' rsInsert.Close
Set rsInsert = Nothing
' SQL statement removes kit items from checklist report 05/07/03 JE
' SQL = "DELETE ChecklistReportTemp FROM ChecklistReportTemp INNER JOIN InventoryMasterTable ON ChecklistReportTemp.ItemNum = InventoryMasterTable.ItemNum WHERE InventoryMasterTable.KitId ='k'"
' Set rsDelete = New ADODB.Recordset
' rsDelete.Open SQL, DB, adOpenDynamic, adLockOptimistic
' rsInsert.Close
Set rsDelete = Nothing
'closing the recordset and getting ready for a new one.
rsGetLineItems.Close: Set rsGetLineItems = Nothing
Screen.MousePointer = vbDefault
' Create SQL Statement
SQL = "Select * from ContractMasterTable where contractnumber = " & txtDocNo
Set rsCheck = New ADODB.Recordset
rsCheck.Open SQL, DB, adOpenDynamic, adLockOptimistic
'determine if document is open or closed
If cboDocType.Text <> "SALE" Then
If rsCheck("StatusO_C") = False Then 'document is Open
If UpdateFlag = True Then
MsgBox "Please save this document before printing"
Exit Sub
End If
End If 'if this document was closed, bypass the UpdateFlag check
End If
' Open Selection statement
Set adoRs = New ADODB.Recordset
adoRs.CursorType = adOpenKeyset
adoRs.LockType = adLockOptimistic
' Create the Report object and path 05/07/04 JE
Set Application = CreateObject("CrystalRuntime.Application")
Set Report = Application.OpenReport(gblReports & "Checklist1.rpt")
With Report
strSelectionFormula = "{qryQuanityCheckListTemp.ContractNumber}=" & txtDocNo
.DiscardSavedData
.Database.SetDataSource adoRs
.RecordSelectionFormula = strSelectionFormula
End With
frmViewer.Show
Screen.MousePointer = vbHourglass
Screen.MousePointer = vbDefault
Set adoRs = Nothing
Set rsCheck = Nothing
DB.Close
' ChecklistReport.ReportFileName = gblReports & "\Checklist.rpt"
'
' ChecklistReport.DataFiles(0) = gblDatabase1
' ChecklistReport.WindowState = crptMaximized
' ChecklistReport.Destination = crptToWindow
'' ChecklistReport.PrinterSelect
' test = ChecklistReport.PrintReport
Exit Sub
ErrHand:
Screen.MousePointer = vbDefault
MsgBox Err.Description, vbCritical, "Print Report"
Err.Clear
'
' 'PrintChecklist Me I dont know why this call was here. AD 3/15/00
' With ChecklistReport
' .DataFiles(0) = gblDatabase1
' .ReportFileName = gblReports & "\Checklist.rpt"
' .WindowState = crptMaximized
' .SelectionFormula = "{ChecklistReportTemp.ContractNumber}=" & txtDocNo
' .Destination = crptToWindow
' .Action = 1
' 'test = ChecklistReport.PrintReport Replace with action = 1. AD 3/15/00
' End With
'
' Screen.MousePointer = vbDefault
'
' If Err <> 0 Then
' If ErrHandle(Err, 0, "") = vbOK Then
' Exit Sub
' End If
' End If
End Sub
You can't tell from the code, as it doesn't use a DSN at all - it uses a proper connection string instead:
The DSN is specified somewhere inside the report, but I haven't used Crystal in years (very intentionally!), so am not sure how to check. If you open the report in Crystal itself, you should be able to find it via one of the menus.Quote:
Originally Posted by mojo69
I will look there and post what I find.
I found that I did not have Crystal Reports databases installed correctly. The issue is resolved.