Trying to update CR Parameters but default value get whiped out

[dbadamion]

I am trying to update crystal reports XI,parameters dynamically in Visual Basic 6.0. The code below works but the default value in report options gets cleared when the report is saved can someone help. In the code below I do not delete “[ALL]” default value but when the report is saved it gets deleted. I created a class to access the database


Public Function RunUpdate()
'On Error GoTo geterror
Dim CrApp As CRAXDRT.Application
Dim x As Integer
Dim c As Integer

Dim CrRep As CRAXDRT.Report
Dim rs As New CLSado 'Table
Dim rsRunQry As New CLSado 'run SQL
Dim rsRunDual As New CLSado 'run Dual
Dim sdefault As String
Dim ilist As Long

'Dim rsError As New CLSado 'Write Error


Set CrApp = New CRAXDRT.Application

rs.pathprop = strdbPath
rs.SQLProp = "select ID,ReportName,TempDirectory , Path , ParameterName, ParameterSQL , CreateBackup ,DefaultPara from Parameter where Active = 'Yes' and ParameterName is not null"
rs.data.MoveFirst

sReportName = rs.data!ReportName
sTempDirectory = rs.data!TempDirectory
sFullPath = rs.data!path
sParameterName = rs.data!parameterName
sParameterSQL = rs.data!ParameterSQL
sTempDirectory = Replace(sTempDirectory, ".rpt", (sTimeStamp & ".rpt"))
sCreateBackup = rs.data!CreateBackup
sID = rs.data!Id
sDefaultPara = IIf(IsNull(rs.data!DefaultPara) = True, "", rs.data!DefaultPara)


For x = 1 To icount Step 1




'FileCopy "C:\crtests\Report1.rpt", "C:\Temp\Report1.rpt"
FileCopy sFullPath, sTempDirectory
Set CrRep = CrApp.OpenReport(sTempDirectory)
ilist = (CrRep.ParameterFields.GetItemByName(sParameterName).NumberOfDefaultValues)
'ilist = (CrRep.ParameterFields.GetItemByName(sParameterName).NumberOfDefaultValues - 1)
For c = 1 To ilist Step 1

If c > ilist Then
Exit For
End If
If CrRep.ParameterFields.GetItemByName(sParameterName).GetNthDefaultValue(c) = "[ALL]" Or CrRep.ParameterFields.GetItemByName(sParameterName).GetNthDefaultValue(c) = "ALL" Then
'ilist = ilist - 1
Else
CrRep.ParameterFields.GetItemByName(sParameterName).DeleteNthDefaultValue (c)
ilist = ilist - 1
c = c - 1
End If
' c = c + 1
Next
'Do Until CrRep.ParameterFields.GetItemByName(sParameterName).NumberOfDefaultValues = 0
'c = c + 1
'If CrRep.ParameterFields.GetItemByName(sParameterName).GetNthDefaultValue(1) = "[ALL]" Or CrRep.ParameterFields.GetItemByName(sParameterName).GetNthDefaultValue(1) = "ALL" Then
'Else
'CrRep.ParameterFields.GetItemByName(sParameterName).DeleteNthDefaultValue (1)
'End If
'c = c + 1
'Loop

'good If CStr(sDefaultPara) <> "" And InStr(sDefaultPara, "*") = 0 Then
'good If (InStr(sDefaultPara, "select") <> 0 And InStr(sDefaultPara, "from") <> 0) Or (InStr(sDefaultPara, "max") <> 0 And InStr(sDefaultPara, "select") <> 0 And InStr(sDefaultPara, "from") <> 0) Or (InStr(sDefaultPara, "max") <> 0 And InStr(sDefaultPara, "select") <> 0 And InStr(sDefaultPara, "from") <> 0) Then
'good rsRunDual.pathprop = strdbPath
'good rsRunDual.SQLProp = sDefaultPara
'good rsRunDual.data.MoveFirst
'good sdefault = rsRunDual.data(0)
'CrRep.ParameterFields.GetItemByName(sParameterName).AddDefaultValue (sdefault)
'CrRep.ParameterFields.GetItemByName(sParameterName).AddCurrentValue(

'good CrRep.ParameterFields.GetItemByName(sParameterName).AddCurrentValue (sdefault)
'good End If
'good End If
'get
rsRunQry.pathprop = strdbPath
rsRunQry.SQLProp = sParameterSQL
'rsRunQry.data.MoveFirst


Do Until rsRunQry.data.EOF = True
'Loop
'CrRep.ParameterFields.GetItemByName(sParameterName).AddDefaultValue (rs.data!sParameterName)
If InStr((rsRunQry.data(0)), "All") = 0 And InStr((rsRunQry.data(0)), "[ALL]") = 0 And InStr((rsRunQry.data(0)), "ALL") = 0 Then
CrRep.ParameterFields.GetItemByName(sParameterName).AddDefaultValue (rsRunQry.data(0))
End If
rsRunQry.data.MoveNext

Loop

'Save
CrRep.SaveAs sFullPath, crDefaultFileFormat

'Delete File
If sCreateBackup = "No" Then
Kill (sTempDirectory)
End If

If x < icount Then
rs.data.MoveNext
sReportName = rs.data!ReportName
sTempDirectory = rs.data!TempDirectory
sFullPath = rs.data!path
sParameterName = rs.data!parameterName
sParameterSQL = rs.data!ParameterSQL
sTempDirectory = Replace(sTempDirectory, ".rpt", (sTimeStamp & ".rpt"))
sID = rs.data!Id
sCreateBackup = rs.data!CreateBackup
sDefaultPara = IIf(IsNull(rs.data!DefaultPara) = True, "", rs.data!DefaultPara)
End If
Next x


'Release the references
rsRunQry.data.Close
Set rsRunQry = Nothing
rs.data.Close
Set rs = Nothing
Set CrRep = Nothing
Set CrApp = Nothing


'geterror:

'rsError.pathprop = strdbPath
' sError = "insert into errorlog (ReportID ,Message , Date) values (" & sID & sReportName & "," & Err.Description & "," & sTimeStamp & ")"

' rsError.SQLProp = sError
'If rsError.data.State <> 0 Then
' rsError.data.Close
' Set rsError = Nothing
' End If
End Function






Public Function CountRecords() As Integer
'On Error GoTo geterror
Dim rsCnt As New CLSado
rsCnt.pathprop = strdbPath

rsCnt.SQLProp = "select count(*) AS Cnt from Parameter where Active = 'Yes' and ParameterName is not null "

icount = rsCnt.data!Cnt

CountRecords = rsCnt.data!Cnt


'geterror:

' rsError.pathprop = strdbPath
'sError = "insert into errorlog (ReportID ,Message , Date) values (" & sID & sReportName & "," & Err.Description & "," & sTimeStamp & ")"

'rsError.SQLProp = sError

'If rsError.data.State <> 0 Then
'rsError.data.Close
'Set rsError = Nothing
'End If
End Function