Posts by aktharshaik

As per your code my assumptions
1) conn is ADODB.Connection for access DB
2) iMUSIC is table in SQL Server DB

Private Sub ListTemp_Click()

        Dim sqltambah As String

        'Better Add Error Handler Code also
        On Error goto ListTemp_Click_Error

        'if you already have an active ADODB.Connection to your SQL Server Schema use it.
        'If not then create one ADODB.Connection and connect it to your SQL Server Schema
        'where your iMUSIC table resides
        'Here I assume sqlconn as the ADODB.Connection to your SQL Server Schema

        Dim sqlconn as New ADODB.Connection
        sqlconn.open "<here goes the SQL provider connection string to your SQL Server Schema>"

        'sqltambah is only a string variable which holds your Insert Query
        sqltambah = "INSERT INTO iMUSIC " & _
                    "(ID_MUSIC, TITLE, SINGER, FID_M_CATEGORY, FILE_NAME, SOURCE, PATH, ACTIVE, VOL , ANALOG, DATE_ADDED)" & _
                    " VALUES (" & _
                    "'" & Text1.Text & "', " & _
                    "'" & Text3.Text & "', " & _
                    "'" & Text2.Text & "', " & _
                    "'" & CB_kategori.Text & "', " & _
                    "'" & filename_txt.Text & "', " & _
                    "'" & source_txt.Text & "', " & _
                    "'" & path_txt.Text & "', " & _
                    "'" & active.Caption & "', " & _
                    "'" & vol_txt.Text & "', " & _
                    "'" & CB_Analog.Text & "', " & _
                    "'" & DTPicker1.Value & "' " & _
                    ")"

        'This is the Access Database Recordset with  conn  as ADODB.Connection to your MS-Access DB
        Set rsmusik = New ADODB.Recordset …

Hi,

You can delete any file from the disk using the KILL command

Syntax:
KILL <filename with path>

Before deleting any file you can check if it exists in the path or not first.

If Dir("D:\PRLIST.XLS", vbNormal) <> "" Then
        If MsgBox("DELETE FILE?", vbYesNo + vbInformation, "DELETION") = vbYes Then
            Kill "D:\PRLIST.XLS"
        End If
    Else
        MsgBox "No Such File Exists."
    End If

Regards
Shaik Akthar

Corrected Code

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyC Then
        If Shift = 2 Then
             Clipboard.Clear
             Clipboard.SetText grd.Clip
        End If
    End If
End Sub

PS: For this to work set the KeyPreview Property of the your FORM to "True"

Regards
Shaik Akthar

Hi!!!

For more information, read this KB Article

http://support.microsoft.com/kb/193866

Hi!!!

Use the following syntax for the SQL Query

SELECT * from customer where customercode = ?

? will display the parameter in the parameter tab

Hi!
I don't know how u have managed to assign the client number to a variable. but here is one way to do so.
when u execute the query using the Execute function, all the values retrieved are as a recordset.
For Eg:

Dim myGrade as String
Dim myClientNo as Long

myName = deSub.conn.Execute("SELECT clientgrade FROM individualsubs WHERE firstname = '" & txtfname.Text & "' AND surname = '" & txtsurname.Text & "'")(0)
myClientNo = deSub.conn.Execute("SELECT clientgrade, clientnumber FROM individualsubs WHERE firstname = '" & txtfname.Text & "' AND surname = '" & txtsurname.Text & "'")(1)

Here (0) and (1) tell which retrieved value is to be used.

Also be careful if any null values are to be retrieved and handle the error respectively.

if badge_id column a numeric, then omit the quotation marks for '1234'

what is the error msg u r getting.

rs.Open "Select PCODE from Product WHERE PCODE = '" & Trim(Text1.Text) & "'", cn, adOpenKeyset, adLockPessimistic
If rs.BOF = False Then
    MsgBox "The Product Code is Already Exist!", vbCritical
    If rs.State Then rs.Close
    Set rs = Nothing
    Exit Sub
Else

First initialize all text boxes from txt1 to txt7 = ""
Then get the data from table using a query for sum of Stunden for different Taetigkeit and populate the textboxes.

Private Sub Combo1_Click()

    Dim rs As New ADODB.RecordSet

    On Error GoTo Combo1_Click_Error

    'This statement calls the Procedure to clear the textboxes.
    Call ClearTextBoxes

'Open the recordset where ProjektNr is 
'equal to the ComboBox Selection
'Here con is the Database Connection Object I have used.
'U have to replace with the one which u r using

    rs.Open " SELECT STUNDEN.Taetigkeit, SUM(STUNDEN.Stunden) as TotStunden FROM STUNDEN WHERE STUNDEN.ProjektNr = '" & Combo1.Text & "' GROUP BY STUNDEN.Taetigkeit ", con, adOpenKeySet, adLockReadOnly

    While Not rs.EOF()
        Select Case rs!Taetigkeit
                Case "Technische Bearbeitung"
                    txt1.Text = rs!TotStunden
                Case "CAD Erstellungen"
                    txt2.Text = rs!TotStunden
                Case "Berechnungen"
                    txt3.Text = rs!TotStunden
                Case "Besprechung"
                    txt4.Text = rs!TotStunden
                Case "Verwaltung"
                    txt5.Text = rs!TotStunden
                Case "Bauleitung"
                    txt6.Text = rs!TotStunden
                Case "Montage"
                    txt7.Text = rs!TotStunden
        End Select
        rs.MoveNext
    Wend
    If txt1.Text = "" then txt1.Text = "0"
    If txt2.Text = "" then txt2.Text = "0"
    If txt3.Text = "" then txt3.Text = "0"
    If txt4.Text = "" then txt4.Text = "0"
    If txt5.Text = "" then txt5.Text = "0"
    If txt6.Text = "" then txt6.Text = "0"
    If txt7.Text = "" then txt7.Text = "0"


Combo1_Click_Done:
    If Not rs Is Nothing Then If rs.State then rs.Close
    Set rs = Nothing
    Exit Sub

Combo1_Click_Error:
    MsgBox Err.Number & " : " & Err.Description
    Resume Combo1_Click_Done

End Sub

'This function is to clear …

Also checkout this link once. may get some tips

http://www.msaccesstips.com/2008/05/selected-list-box-items-and-dynamic.shtml

Hi! At Last came up with some solution. Try this. Checkout the Attachment.

Also i am unable to have a picture of your form and your exact requirement.
ZIP the file and Upload

Not much clear with ur exact requirement. If u don't mind, plz upload the DB here.

Dim x As Integer
    Dim n As Integer
    Dim i As Integer
    Dim Tot As Double

    x = Val(text1.text)
    n = Val(Text2.text)
    If n <=0 Or x <1 Then
        MsgBox "Enter Proper Values"
        Exit Sub
    End If

    Tot = 0
    i = 1
    Do While i <=  n
        Tot = Tot + (x ^ i)
        i = i + 1
    Loop
    i = 0
    Do While i <=  (n + 1)
        Tot = Tot - (x ^ i)
        i = i + 1
    Loop
    MsgBox Tot

Dim x, n, i As Integer
    Dim Tot As Double

    x = Val(Text1.Text)
    n = Val(Text2.Text)
    If n <= 1 Or x <= 0 Then
        MsgBox "Enter Proper Values", vbCritical
        Exit Sub
    End If

    Tot = 0
    i = 1
    Do While i <=  n
        Tot = Tot + (x ^ i)
        i = i + 1
    Loop

Dim x, n, i As Integer
    Dim Tot As Double

    x = Val(Text1.Text)
    n = Val(Text2.Text)
    If n <= 1 Or x <= 0 Then
        MsgBox "Enter Proper Values", vbCritical
        Exit Sub
    End If

    Tot = 0
    i = 1
    Do While i <=  n
        Tot = Tot + (x ^ i)
        i = i + 1
    Loop

Is it in VB or MSAccess forms u r writing the code?

Please post the entire procedure which is not giving u the result.

if u have 2 commands and want the 2nd command to run after a certain interval of time, u can use the timer control.

During design time; set its interval property to ur required time of pause (in milliseconds), set Enable property to false

Now for the coding part, after the 1st command statement just Enable the timer. In the Timer() event of the timer, write the 2nd Command followed by Timer1.Enabled = False for the Timer control.

I assume that u have two command buttons and one timer control on your form. When the first command button is clicked it executes the statements and in the last statement of this event, the timer control is enabled. Once the timer control is enabled the counting starts and after an interval of 5000 ms the Timer() event is fired. There the call for the second command button click event is placed. After the execution of which the timer control is disabled.

If u dont disable the Timer control after the call for the Command2 click event, then Timer() event it is fired again and again for every 5000 ms.

Eg:

Private Sub Form_Load()
    Timer1.Interval = 5000 'for 5 seconds
    Timer1.Enabled = False
End Sub

Private Sub Command1_Click()
    'Write your code for the first command
    Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
    Call Command2_Click
    Timer1.Enabled = False
End Sub

Private Sub Command2_Click()
    'Write your code for the Second Command
End Sub

Vtemp = CurrentDb.OpenRecordset("SELECT MAX(CRID_INDEX.CRID_NUM) FROM CRID_INDEX")(0)

Here (0) is to return the value of the first field in the query and store it into Vtemp. If say u have more number of fields and u want to get the value of the third field in the sequence of recordset values u have to write (2) like

x = CurrentDb.OpenRecordset("SELECT sName, sLastName, sAge FROM EMPLOYEE WHERE sEmpId = 23")(2)
This will return the value of field age into variable x

Check out the following attachment. I have modified it as far and as much as i could understand. Hope this solves ur problem.

Private Sub Combo1_Click()
    Set rs2 = New ADODB.Recordset
    rs2.Open "select * from Product where pcode='" & Combo1.Text & "'", cn, adOpenKeyset, adLockPessimistic
    Set MSHFlexGrid1.DataSource = rs2
    If rs2.RecordCount > 0 Then
        Text17.Text = Date
        Text4.Text = rs2!price
        If IsNull(rs2!pstock) = True Then
            Text12.Enabled = False
            MsgBox "You Cannot Buy This One" 
            Exit sub
        ElseIf VAL(rs2!pstock) <= 0 Then
            Text12.Enabled = False
            MsgBox "You Cannot Buy This One" 
            Exit Sub
        Else
            Text12.Enabled = True
        End If
    End If
End Sub

for bold

.Shape.TextFrame.TextRange.Lines(1).Font.Bold = msoCTrue

Also add this line for center alignment of the Title in the cell.

.Shape.TextFrame.TextRange.Lines(1).ParagraphFormat.Alignment = ppAlignCenter

Add this line after setting the font size for underline

.Shape.TextFrame.TextRange.Lines(1).Font.Underline = msoCTrue

Dim iVar As Integer

    For iVar = 1 To Slide1.Shapes.Count
        If Slide1.Shapes(iVar).Type = msoTable Then
            With Slide1.Shapes(iVar).Table.Cell(1, 1)
                .Shape.TextFrame.TextRange.Lines(1).Font.Name = "Verdana"
                .Shape.TextFrame.TextRange.Lines(1).Font.Size = 40
                With .Shape.TextFrame.TextRange.Lines(3).ParagraphFormat.Bullet
                    .RelativeSize = 1.25
                    .Font.Color = RGB(255, 0, 255)
                End With
                With .Shape.TextFrame.TextRange.Lines(4).ParagraphFormat.Bullet
                    .RelativeSize = 1.25
                    .Font.Color = RGB(255, 0, 255)
                End With
                With .Shape.TextFrame.TextRange.Lines(5).ParagraphFormat.Bullet
                    .RelativeSize = 1.25
                    .Font.Color = RGB(255, 0, 255)
                End With
            End With
        End If
    Next

In the last post u can substitute any fontname and size in place of Tahoma and 20.

If you want this to be changed programmatically then here is the code

Dim iVar As Integer

    'Here you may replace Slide1 with the name of your slide.
    For iVar = 1 To Slide1.Shapes.Count
        'Here any object which is of the type table is taken
        'An error is returned if the cell row or column do not exist.
        If Slide1.Shapes(iVar).Type = msoTable Then
            With Slide1.Shapes(iVar).Table.Cell(1, 1)
                .Shape.TextFrame.TextRange.Font.Name = "Tahoma"
                .Shape.TextFrame.TextRange.Font.Size = 20
            End With
            With Slide1.Shapes(iVar).Table.Cell(3, 1)
                With .Shape.TextFrame.TextRange.ParagraphFormat.Bullet
                    .RelativeSize = 1.25
                    .Font.Color = RGB(255, 0, 255)
                End With
            End With
            With Slide1.Shapes(iVar).Table.Cell(4, 1)
                With .Shape.TextFrame.TextRange.ParagraphFormat.Bullet
                    .RelativeSize = 1.25
                    .Font.Color = RGB(255, 0, 255)
                End With
            End With
            With Slide1.Shapes(iVar).Table.Cell(5, 1)
                With .Shape.TextFrame.TextRange.ParagraphFormat.Bullet
                    .RelativeSize = 1.25
                    .Font.Color = RGB(255, 0, 255)
                End With
            End With
        End If
    Next

Which Table Cell. Is it in MS-Access u want?
or
Is it any cell in the FlexGrid in VB?

Private Sub Combo1_Click()
    Set rs2 = New ADODB.Recordset
    rs2.Open "select * from Product where pcode='" & Combo1.Text & "'", cn, adOpenKeyset, adLockPessimistic
    Set MSHFlexGrid1.DataSource = rs2
    If rs2.RecordCount > 0 Then
        Text17.Text = Date
        Text4.Text = rs2!price
        Text12.Enabled = VAL(rs2!pstock) > 0
    End If
End Sub

In the grd_Data_Loader() after opening the connection put this statement.

Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\PharmacyInventory.mdb;Jet OLEDB:System Database=system.mdw;", "admin", ""

    cn.Execute " DELETE FROM CustomerReturn WHERE VAL(quantity) = 0 "

call grd_Data_Loader again after deleting the record

I think that the data type of your quantity field is text. you have to typecast it to number and then check for the records where quantity = 0 and delete them.

the following query will delete all records where quantity is = 0

cn.Execute " DELETE from Soldto where val(quantity)=0"

or if fora a particular cno then u can write

cn.Execute " DELETE from Soldto where val(quantity)=0 and cno = '" & Combo1.Text & "'"

R u getting any error from the procedure mentioned by you?
If yes then what is the error.
or may be try this
Open the query in Dynamic mode

rs1.Open "Select * from Soldto where cno='" & Combo1.Text & "'", cn, adOpenDynamic, adLockOptimistic

PLZ REFER THE ATTACHED PROJECT. I DON'T KNOW WHETHER I HAVE SATISFIED UR EXACT NEED / NOT.

I AM UPLOADING TWO DIFFERENT STYLES OF SOLUTIONS.

one with normal textboxes and another with an array of text boxes. In my opinion the array logic will be very comfortable.

USE THE OBJECT CurrentDb.

Public Sub GetMaxCRID()

    Dim Vtemp As Integer

    On Error GoTo GetMaxCRID_Error

    'Here first we check whether or not if any record exists in the table
    If CurrentDb.OpenRecordset("SELECT COUNT(CRID_INDEX.CRID_NUM) FROM CRID_INDEX")(0) > 0 Then
        Vtemp = CurrentDb.OpenRecordset("SELECT MAX(CRID_INDEX.CRID_NUM) FROM CRID_INDEX")(0)
    Else
        Vtemp = 0
    End If
    'Now you have the maximum number in the field CRID_NUM

GetMaxCRID_Done:
    Exit Sub

GetMaxCRID_Error:
    MsgBox "An error has occured in procedure GetMaxCRID." & vbCrLf & vbCrLf & "Error No: " & Err.Number & vbCrLf & Err.Description
    Resume GetMaxCRID_Done

End Sub

Could not get your exact requirement from your post. plz use the below checklist to be more clear for your req.

1. Please can u give some test values for the values in the ListBox 1 (approx. 10-12 is enough)
2. The numbers in the 7 text boxes.
3. and the Required result from those values.

In which appliation R U writing VBA code? MS-Access or excel?
Where is the table from which u want to read the fields from? Is it an Excel Spreadsheet or an Access Database or some other DB?

Please make some clarity in your problem and will help to solve it out precisely.

The Logic for the removal of the related records in the database can be written just before the Remove event of the ListView. After all matched Items are done, U will have the database updated as well as the ListView and I think there is no need to Reload the ListView, which involved again querying the DB. Alternatively it can be done to re-confirm if the records are really deleted from the DB or not.

Regards
Shaik Akthar

Try this code

Dim iVal As Integer
    Dim lCount As Integer

    lCount = li.ListItems.Count
    For iVal = 1 To lCount
        If iVal > lCount Then Exit For
        'If u want to compare to the First Column
        If Trim(li.ListItems(iVal).Text) = Trim(Text1.Text) Then
            li.ListItems.Remove (iVal)
            iVal = iVal - 1
            lCount = lCount - 1
        End If

''If u want to compare to the other Column use SubItems
''SubItems(1) is 2nd col, SubItems(2) is 3rd col and so on...
'        If Trim(li.ListItems(iVal).SubItems(1)) = Trim(Text1.Text) Then
'            li.ListItems.Remove (iVal)
'            iVal = iVal - 1
'            lCount = lCount - 1
'        End If
 
   Next

also while comparing if u don't want it to be case sensitive use the UCASE() function

If UCase(Trim(li.ListItems(iVal).Text)) = UCase(Trim(Text1.Text)) Then

Regards
Shaik Akthar

U need not select the items to remove them.

Loop thru all the items in the listview with index for tracking the item against the loop variable. compare the values of each item and delete which ever match the criteria. when deletion occurs the indices of the items following the deleted item will change. hence keep track of the last index.

If still problem persists then i will try to help u with some sample code.

Regards
Shaik Akthar

Dear Taher,

Your entire logic is correct. there is no mistake except for the fieldnames which u r using. they have a space in between. if u need to specify fieldnames which have space then use either of the following ways to denote them.

For field Student Id use
rst.Fields("Student Id")
or
rst![Student Id]

I have modified the project and am uploading it back for ur reference. hope this solves ur problem.

Another suggestion is that try not using the fieldnames with spaces, instead use a underscore to connect if the fieldname is of two words like

u can use "Student_Id" instead of "Student Id"
"Student_Name" instead of "Student Name" and "Roll_No" instead of "Roll No"

Regards
Shaik Akthar

I have just put a label outside the select case BLOCK to transfer the control outside of the select block once any case is executed. but it is not mandatory. YOU CAN OMIT THE GOTO STATEMENT

Regards
Shaik Akthar

Use Select Case

Select Case MSFlexGrid1.ColSel
    Case 0:
         form1.Text1.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, MSFlexGrid1.ColSel)
         goto Label1
    Case 1:
         form1.Text2.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, MSFlexGrid1.ColSel)
         goto Label1
    Case 2:
         form1.Text3.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, MSFlexGrid1.ColSel)
         goto Label1
    Case 3:
         form1.Text4.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, MSFlexGrid1.ColSel)
         goto Label1
End Select

Label1:

Regards
Shaik Akthar

Can u attach the three forms?

If the remaining cells are the adjacent to each other, you can hardcode the column numbers!

form1.Text1.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, 0) 'For data in Column 0
form1.Text2.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, 1) 'For data in Column 1
form1.Text3.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, 2) 'For data in Column 2
form1.Text4.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, 3) 'For data in Column 3

The row is constant for the row u have selected. only change the columns.

Regards
Shaik Akthar

Since in the Branching Statement one and only one condition is executed, u can first finish getting the query. and then apply the Execute Statement.

Dim sql12 As String
If release.Enabled = True And nonosc.Enabled = True Then
        sql12 = "update Passport_Release_Information_N set Ename2='" & taker.Text & "' ,Any_ID1='" & takerid.Text & "' ,E_ID1 = '" & Label7.Caption & "',R_Status= '" & status.Caption & "' WHERE R_ID_N='ASDF'"
Else
    If release.Enabled = True And osc.Enabled = True Then
        sql12 = "update Passport_Release_Information_O set E_ID_3='" & takerid.Text & "' ,E_ID_4 = '" & Label31.Caption & "',R_Status= '" & status.Caption & "' WHERE R_ID_N='ASDF'"
    Else
        sql12 = ""
    End If
End If
If sql12 <> "" then
  CN.Execute sql12
  status.Caption = "RELEASED"
End If

Regards
Shaik Akthar

Sorry. Could not follow your requirement correctly. Can u plz explain more specifically with sample data.

nw... i want to connect every individual field in my database to another corresponding field for example i hv a combo box(empname) on my form and a label for corresponding ID(empid) and in my database the table name is Employee and fields for these two are E_id E_name... im not able to connect the fields individually... i tried connecting with the following code

Regards
Shaik Akthar

Do u want to write this code :

a) from within an Excel file in VBA Editor?

OR

b) from within Word file in VBA Editor?

OR

c) from VISUAL BASIC IDE?

Regards
Shaik Akthar

The code after the Exit Sub cannot be reached at all. the procedure exits at that point and the code which u have written below the Error Handler Label is never reached. That's why the error.

Private Sub Form_Load()

    On Error GoTo Form_Load_Error

    Set con = New ADODB.Connection
    con.Open "Provider=Microsoft.Jet.Oledb.4.0;Data Source=" & App.Path & "\Office Utilization.mdb"
    Call FillLocation
    Call Filllocation2
    
Form_Load_Done:
    Exit Sub

Form_Load_Error:
    MsgBox "An Error has occured in Procedure Form_Load." & vbCrLf & vbCrLf & Err.Number & " : " & Err.Description
    Resume Form_Load_Done



  Dim i As Integer
  
  ' Get a recordset to use with the report
  Set rs = CreateRecords
  
  ' Populate Comboboxes
  For i = 0 To cboSort.Count - 1
    With cboSort(i)
      .AddItem "(None)"
      .AddItem "locname"
      .AddItem "floorname"
      .AddItem "seatno"
      .AddItem "empname"
      .ListIndex = 0
    End With
  Next

End Sub

Please correct this procedure. It should be like this.

Private Sub Form_Load()

    On Error GoTo Form_Load_Error

    Set con = New ADODB.Connection
    con.Open "Provider=Microsoft.Jet.Oledb.4.0;Data Source=" & App.Path & "\Office Utilization.mdb"
    Call FillLocation
    Call Filllocation2
    
    Dim i As Integer
  
    ' Get a recordset to use with the report
    Set rs = CreateRecords

    ' Populate Comboboxes
    For i = 0 To cboSort.Count - 1
        With cboSort(i)
            .AddItem "(None)"
            .AddItem "locname"
            .AddItem "floorname"
            .AddItem "seatno"
            .AddItem "empname"
            .ListIndex = 0
        End With
    Next

Form_Load_Done:
    Exit Sub

Form_Load_Error:
    MsgBox "An Error has occured in Procedure Form_Load." & vbCrLf & vbCrLf & Err.Number & " : " & Err.Description
    Resume Form_Load_Done

End Sub

Hope this solves ur problem

Regards