View Single Post
  #2 (permalink)  
Old 06-04-2008, 07:00 PM
ccoonen ccoonen is offline
PT Staff
Awards Showcase
Quality Tutorial Quality Tutorial Quality Tutorial Quality Tutorial 
Total Awards: 4
Join Date: Jun 2007
Location: Wisconsin
Posts: 317
iTrader: (0)
ccoonen is on a distinguished roadccoonen is on a distinguished roadccoonen is on a distinguished roadccoonen is on a distinguished road
Code:
    Dim ObjDAO As Object
    Dim ObjDataBase As Object
    Dim ObjRecordSet As Object
Private Sub OpenDataMDBBase()
    Set ObjDAO = CreateObject("DAO.DBEngine.35")
    Set ObjDataBase = ObjDAO.OpenDatabase("C:\Temp\EmpData.mdb")
    Set ObjRecordSet = ObjDataBase.OpenRecordset("DataBaseProject")
End Sub
Private Sub CmdEnd_Click()
    End
    Unload Me
End Sub

Private Sub cmdGo_Click()
    'On Error GoTo ErrorHandalar
    Screen.MousePointer = vbHourglass
    Dim strQryString As String
    If optName.Value = True Then
        Dim strTempQryString As String
        Dim I As Integer
        Dim J As Integer
        J = 1
        strTempQryString = "{DatabaseProject.EmployeeName} ="
        If lstEmployee.SelCount > 1 Then
            For I = 0 To lstEmployee.ListCount - 1
                If lstEmployee.Selected(I) = True Then
                    If J = 1 Then
                        strQryString = strTempQryString & "'" & lstEmployee.List(I) & "'"
                        J = J + 1
                    Else
                        strQryString = strQryString & " Or " & strTempQryString & "'" & lstEmployee.List(I) & "'"
                    End If
                End If
            Next I
        Else
                    strQryString = strQryString & strTempQryString & "'" & lstEmployee.List(lstEmployee.ListIndex) & "'"
        End If
 
    With CrystalReport1
        .ReportFileName = App.Path & "\EmpDetails.rpt"
        .Connect = App.Path & "\EmpData.mdb"
        .DiscardSavedData = True
        .RetrieveDataFiles
        .ReportSource = 0
        .SQLQuery = "Select * from DataBaseProject order by EmployeeName"
        .ReportTitle = "Employee Details Report"
        .Destination = crptToWindow
        .PrintFileType = crptCrystal
        .WindowState = crptMaximized
        .WindowMaxButton = False
        .WindowMinButton = False
        If strQryString <> "{DatabaseProject.EmployeeName} ='Select All'" Then
            .SelectionFormula = strQryString
        End If
        
        .Action = 1
    End With
  End If
  If optDOB.Value = True Then
        If txtFromDate.Text <> "" And txtToDate.Text <> "" Then
            strQryString = "{DatabaseProject.EmployeeDOB} >= #" & Format(txtFromDate.Text, "mm/dd/yyyy") & "# And {DatabaseProject.EmployeeDOB} <= #" & Format(txtToDate.Text, "mm/dd/yyyy") & "#"
        End If
     With CrystalReport1
        .ReportFileName = App.Path & "\EmpDetails.rpt"
        .Connect = App.Path & "\EmpData.mdb"
        .DiscardSavedData = True
        .RetrieveDataFiles
        .ReportSource = 0
        .SQLQuery = "Select * from DataBaseProject order by EmployeeName"
        .ReportTitle = "Employee Details Report"
        .Destination = crptToWindow
        .PrintFileType = crptCrystal
        .WindowState = crptMaximized
        .WindowMaxButton = False
        .WindowMinButton = False
        .SelectionFormula = strQryString
        .Action = 1
    End With
  End If
    Screen.MousePointer = vbDefault
    Exit Sub
ErrorHandalar:
    MsgBox CStr(Err.Number) + Err.Description
    Screen.MousePointer = vbDefault
End Sub

Private Sub Form_Load()
    Call CopyMdbFileInReportLocation
    Call OpenDataMDBBase '//Open MDB DataBase
    Call FillListBox '//Fill List Box With Employee Names
    optName.Value = True
End Sub
Private Sub FillListBox()
    lstEmployee.AddItem "Select All"
    Do While Not ObjRecordSet.EOF
       lstEmployee.AddItem ObjRecordSet.Fields("EmployeeName")
       ObjRecordSet.MoveNext
    Loop
    lstEmployee.Selected(0) = True
End Sub
Private Sub CopyMdbFileInReportLocation()
    '**************Imp Note**********************
    'This procedure is used only to generate the report with out an error, because in crystal report
    'I have specified hard coded database path location ("C:\Temp\EmpData.mdb").
    'When you uninstall or delete the application pl delete database as well.
    '*********************************************
    Dim fso As Object, f As Object, MyFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not (fso.FolderExists("C:\Temp")) Then
       Set f = fso.CreateFolder("C:\Temp")
    End If
    If Not (fso.FileExists("C:\Temp\EmpData.mdb")) Then
        Set MyFile = fso.GetFile(App.Path & "\EmpData.mdb")
        MyFile.Copy ("C:\Temp\EmpData.mdb")
    End If
    If (fso.FileExists(App.Path & "\EmpData.mdb")) Then
        fso.DeleteFile (App.Path & "\EmpData.mdb")
    End If
End Sub
Reply With Quote