gingank 0 Junior Poster

Below is my code help me see got what error that make it got run time error . when debug it show AppExcel.ActiveWorkbook.Save.

Private Sub cmdPrint_Click()

    Dim sql As String
    Dim sql1 As String
    Dim rs As adodb.Recordset
    
    If Trim(Combo1.Text) = "ALL" Then
        sql = sql1 & " "
        
    ElseIf Trim(Combo1.Text) = "MGMT" Then
        sql1 = sql1 & " and b.staff_joblevel = 'MGMT' "
        
    ElseIf Trim(Combo1.Text) = "EXEC" Then
        sql1 = sql1 & " and b.staff_joblevel = 'EXEC' "
        
    ElseIf Trim(Combo1.Text) = "NEXE" Then
        sql1 = sql1 & " and b.staff_joblevel = 'NEXE' "
        
    ElseIf Trim(Combo1.Text) = "OPER" Then
        sql1 = sql1 & " and b.staff_joblevel = 'OPER' "
        
    End If
    
    
    If Trim(Combo2.Text) = "ALL" Then
        SQL2 = " "
         
    ElseIf Trim(Combo2.Text) = "1" Then
        SQL2 = " and recycle_badge = 1 "
        
    ElseIf Trim(Combo2.Text) = "0" Then
        SQL2 = " and recycle_badge = 0 "
        
    End If
    
    
    sql = "select a.returned_id, a.date_insert, b.staff_no, b.staff_name, b.staff_joblevel, (b.staff_branch+b.staff_division+b.staff_dept+b.staff_section) as costblock, b.staff_group, c.sec_shortname " _
        & "from staff_badgeReturn as a " _
        & "join staff as b on (b.staff_no = a.staff_no) " _
        & "join section as c on (c.sec_compcode = b.staff_comp and c.sec_brchcode = b.staff_branch and c.sec_divcode = b.staff_division and c.sec_deptcode = b.staff_dept and c.sec_code = b.staff_section) " _
        & "where date_insert >= '" & dtpick4 & "' " _
        & "and date_insert <= '" & dtpick5 & "' " & sql1 & SQL2
        
    Set rs = New adodb.Recordset
    With rs
        .ActiveConnection = cnUnisemsql
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
        .Open sql
            
    End With
    
   
    FileName = "BadgeReturn.xls"
    Dim row As Integer
    row = 4
    
    If rs.RecordCount > 0 Then
        If OpenExcel(FileName) Then
            Set wSheet = AppExcel.Sheets(1)
                AppExcel.Sheets(1).Name = "BadgeReturn"
                With wSheet
                    ProgressBar.Visible = True
                    ProgressBar.Max = rs.RecordCount
                    ProgressBar.Value = 0
                    
                    Do Until rs.EOF
                        .Cells(row, 1) = rs!Staff_no
                        .Cells(row, 2) = rs!staff_Name
                        .Cells(row, 3) = rs!CostBlock
                        .Cells(row, 4) = rs!staff_joblevel
                        .Cells(row, 5) = rs!sec_shortname
                        .Cells(row, 6) = rs!staff_group
                        .Cells(row, 7) = rs!returned_id
                        .Cells(row, 8) = rs!date_insert
                        rs.MoveNext
                        row = row + 1
                                            
                        ProgressBar.Value = ProgressBar.Value + 1
                    Loop
                    
                End With
                
               
        End If
        
        
    Else
        MsgBox "No record have found"
        Exit Sub
        
    End If

    AppExcel.ActiveWorkbook.Save
    AppExcel.Visible = True
    Close EndExcel
    
   
End Sub

Private Sub cmdSearch_Click()
    Dim sql As String
    Dim sql1 As String
    Dim rs As adodb.Recordset

    sql1 = ""
    SQL2 = ""
        
    If (Trim(txtSStaffNo) <> "") Then
        sql1 = sql1 & "and staff_no = '" & Trim(txtSStaffNo) & "' "
    End If
    
    If (Trim(txtSReturnID) <> "") Then
        SQL2 = SQL2 & "and returned_id = '" & Trim(txtSReturnID) & "' "
    End If
    

            
    sql = "SELECT * FROM staff_badgeReturn " _
        & "WHERE date_insert >= '" & Format(dtpick1, "dd/MMM/yyyy") & "' " _
        & "and date_insert <= '" & Format(dtpick2, "dd/MMM/yyyy") & "' " & sql1 & SQL2
            
    Set rs = New adodb.Recordset
    With rs
        .ActiveConnection = cnUnisemsql
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
        .Open sql
            
    End With
    
    
    dgData.AllowAddNew = True
    dgData.AllowUpdate = True
    dgData.AllowDelete = True
    
    
    If Not rs.EOF Then
        Set dgData.DataSource = rs
        dgData.DataChanged = True
        dgData.Refresh
        
    Else
        Set dgData.DataSource = rs
      
        dgData.Refresh
    End If
    
    dgData.Columns("Id").Locked = True
    dgData.Columns("StaffNo").Locked = False
    dgData.Columns("ReturnedID").Locked = False
    dgData.Columns("RecycleBadge").Locked = False
    
    dgData.Columns("RecycleBadge").Button = True
    dgData.Columns("Date").Button = True
        

End Sub

Private Sub dgData_ButtonClick(ByVal ColIndex As Integer)
    Dim iRow As Integer
    Dim iCount As Integer

    With dgData
        iRow = .row
        If ColIndex = dgData.Columns("RecycleBadge").ColIndex Then
            List1.Clear
        
            List1.AddItem "1"
            List1.AddItem "0"
            
            List1.Top = .Top + .RowTop(iRow) + .RowHeight
            List1.Left = .Left + .Columns(ColIndex).Left
            List1.Visible = True
            List1.SetFocus
            
        ElseIf ColIndex = dgData.Columns("Date").ColIndex Then
                        
            dtpick3.Top = .Top + .RowTop(iRow) + .RowHeight
            dtpick3.Left = .Left + .Columns(ColIndex).Left
            dtpick3.Visible = True
            dtpick3.SetFocus
        
        End If
    End With
    
End Sub


Private Sub dtpick3_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
    dgData.Columns("Date").Text = dtpick3
    dtpick3.Visible = False
End Sub


Private Sub dtpick3_Change()
    dgData.Columns("Date").Text = dtpick3
    dtpick3.Visible = False
End Sub

Private Sub Form_Load()

    Dim sql As String
    Dim rs As adodb.Recordset
     
    sql = "select * from staff_badgeReturn " _
        & "where date_insert >= '" & Format(DateTime.Now, "dd/MMM/yyyy") & "'"
    
    Set rs = New adodb.Recordset
    With rs
        .ActiveConnection = cnUnisemsql
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
        .Open sql
        
            
    End With
    
    dgData.AllowAddNew = True
    dgData.AllowUpdate = True
    dgData.AllowDelete = True
    
    
    If Not rs.EOF Then
        Set dgData.DataSource = rs
        dgData.DataChanged = True
        dgData.Refresh
        
    Else
        Set dgData.DataSource = rs
        dgData.Refresh
    End If
    
    dgData.Columns("Id").Locked = True
    dgData.Columns("StaffNo").Locked = False
    dgData.Columns("ReturnedID").Locked = False
    dgData.Columns("RecycleBadge").Locked = False
    
    dgData.Columns("RecycleBadge").Button = True
    dgData.Columns("Date").Button = True
    
    Combo1.Text = "ALL"
    Combo2.Text = "ALL"
    
    dtpick1 = Format(DateTime.Now, "dd/MMM/yyyy")
    dtpick2 = Format(DateTime.Now, "dd/MMM/yyyy")
    dtpick4 = Format(DateTime.Now, "dd/MMM/yyyy")
    dtpick5 = Format(DateTime.Now, "dd/MMM/yyyy")
    
End Sub


Private Sub List1_LostFocus()
    List1.Visible = False
End Sub

Private Sub dtpick3_LostFocus()
    dtpick3.Visible = False
End Sub


'''Private Sub txtBadgeNo_KeyDown(KeyCode As Integer, Shift As Integer)
'''
'''    If KeyCode = vbKeyReturn Then
'''
'''        If txtBadgeNo.Text = "" Then
'''            MsgBox "Please key a badge no"
'''            Exit Sub
'''        End If
'''
'''        Dim sql As String
'''        Dim rs As ADODB.Recordset
'''
'''        sql = ""
'''        sql = sql & "select b.id, b.returned_id, a.staff_name, a.staff_no  from staff as a "
'''        sql = sql & "left join staff_badgeReturn as b on (b.staff_no = a.staff_no) "
'''        sql = sql & "where a.staff_no = '" & txtBadgeNo & "'"
'''
'''        Set rs = New ADODB.Recordset
'''        With rs
'''            .ActiveConnection = cnUnisemsql
'''            .CursorType = adOpenStatic
'''            .Open sql
'''        End With
'''
'''        If rs.RecordCount = 0 Then
'''            MsgBox "No record found"
'''
'''            cmdSave.Enabled = False
'''            cmdupdate.Enabled = False
'''            cmddelete.Enabled = False
'''        Else
'''
'''            If IsNull(rs!returned_id) Then
'''
'''                lblStaffName = rs!staff_Name
'''                txtBadgeNo = rs!staff_no
'''                txtReturnID = ""
'''
'''                cmdSave.Enabled = True
'''                cmdupdate.Enabled = False
'''                cmddelete.Enabled = False
'''            Else
'''                txtID = rs!id
'''                txtStaffName = rs!staff_Name
'''                txtBadgeNo = rs!staff_no
'''                txtReturnID = rs!returned_id
'''
'''                cmdSave.Enabled = False
'''                cmdupdate.Enabled = True
'''                cmddelete.Enabled = True
'''            End If
'''        End If
'''
'''
'''
'''    End If
'''
'''End Sub


Private Sub List1_Click()
    dgData.Columns("RecycleBadge").Text = List1.Text
    List1.Visible = False
    
End Sub



Private Sub txtFBadgeNo_KeyDown(KeyCode As Integer, Shift As Integer)
    
    If KeyCode = vbKeyReturn Then
        Dim sql As String
        Dim rs As adodb.Recordset
        
        sql = "select b.staff_name, (b.staff_branch+b.staff_division+b.staff_dept+b.staff_section) as costblock, c.sec_shortname from staff as b " _
            & "join section as c on (c.sec_compcode = b.staff_comp and c.sec_brchcode = b.staff_branch and c.sec_divcode = b.staff_division and c.sec_deptcode = b.staff_dept and c.sec_code = b.staff_section) " _
            & "where b.staff_no = '" & Trim(txtFBadgeNo) & "'"
        Set rs = New adodb.Recordset
        With rs
            .ActiveConnection = cnUnisemsql
            .CursorType = adOpenStatic
            .LockType = adLockOptimistic
            .Open sql
        End With
        
        If (rs.RecordCount > 0) Then
            lblStaffName = rs!staff_Name
            lblSupvCode = rs!sec_shortname
            lblCostBlock = rs!CostBlock
        Else
            lblStaffName = ""
            lblSupvCode = ""
            lblCostBlock = ""
        End If
        
        Set rs = Nothing
        
        sql = "select * from staff_badgeReturn " _
            & "where staff_no = '" & Trim(txtFBadgeNo) & "'"
        
        Set rs = New adodb.Recordset
        With rs
            .ActiveConnection = cnUnisemsql
            .CursorType = adOpenStatic
            .LockType = adLockOptimistic
            .Open sql
        End With
        
        dgData.AllowAddNew = True
        dgData.AllowUpdate = True
        dgData.AllowDelete = True
        
        
        If Not rs.EOF Then
            Set dgData.DataSource = rs
            dgData.DataChanged = True
            dgData.Refresh
            
        Else
            Set dgData.DataSource = rs
            dgData.Refresh
        End If
    
        dgData.Columns("Id").Locked = True
        dgData.Columns("StaffNo").Locked = False
        dgData.Columns("ReturnedID").Locked = False
        dgData.Columns("RecycleBadge").Locked = False
        dgData.Columns("RecycleBadge").Button = True
        dgData.Columns("Date").Button = True
    
        
    End If
End Sub
Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.