Jx_Man 987 Nearly a Senior Poster Featured Poster
Estella commented: nice link +3
Jx_Man 987 Nearly a Senior Poster Featured Poster

Set MultiSelect = 2 - Extend in Listbox properties.
Press "Ctrl" while you select items.

Private Sub Command1_Click()
Dim i As Integer
For i = 0 To List1.ListCount - 1
    If List1.Selected(i) Then
        Text1.Text = Text1 + List1.List(i) + ","
    End If
Next

End Sub
Naruse commented: great help :) +3
Jx_Man 987 Nearly a Senior Poster Featured Poster

Using Array :

strmsg = "John Doe der"
Dim a() As String

a = Split(strmsg, " ")
Debug.Print a(UBound(a))
Sawamura commented: good example +3
Jx_Man 987 Nearly a Senior Poster Featured Poster

This should working :

Private Sub Command1_Click()
xSearch = Text1.Text
For i = 0 To Grid.Rows - 1
    If xSearch = Grid.TextMatrix(i, 1) Then
        Grid.Row = Grid.TextMatrix(i, 1)
        For j = 1 To Grid.Cols - 1
            Grid.Col = j
            Grid.CellBackColor = vbCyan
        Next j
    End If
Next i
End Sub
Aurax commented: Thanks!!! +0
Jx_Man 987 Nearly a Senior Poster Featured Poster

This an example about struct of employee combining with array

Module1

Public Type Employee
    EmpNo As Integer
    EmpName As String
    EmpPhone As String
End Type

Public Sub SetEmployee(ByRef emp() As Employee, ByVal i As Integer)
    ReDim emp(i)
End Sub

Public Sub SetEmpData(ByRef emp() As Employee, ByVal i As Integer, ByVal no As Integer, ByVal name As String, ByVal phone As String)
    emp(i).EmpNo = no
    emp(i).EmpName = name
    emp(i).EmpPhone = phone
End Sub

'GetEmpData will return array containing employee details
Public Function GetEmpData(ByRef emp() As Employee, ByVal i As Integer) As Employee
    GetEmpData = emp(i)
End Function

Form1
All inputs will use inputbox and just add two button for set and get employee details

Dim NewEmp() As Employee ' declare array as struct of employee
Dim i As Integer

Private Sub Command1_Click()
   ' how many employee to add
    temp = InputBox("How many employee ?")
    SetEmployee NewEmp, Int(temp - 1)

    ' add employee detail
    For i = 0 To UBound(NewEmp)
        EmpNos = InputBox("Emp " & i + 1 & " No")
        EmpNames = InputBox("Emp " & i + 1 & " Name")
        EmpPhones = InputBox("Emp " & i + 1 & " phone")

        SetEmpData NewEmp, i, EmpNos, EmpNames, EmpPhones
    Next
End Sub

Private Sub Command2_Click()
' Extract detail of employee for each array
For i = 0 To UBound(NewEmp)
    MsgBox GetEmpData(NewEmp, i).EmpNo & "," & GetEmpData(NewEmp, i).EmpName & "," & GetEmpData(NewEmp, i).EmpPhone
Next
End Sub
Estella commented: Very good example... +4
ITKnight commented: Very helpful +2
Jx_Man 987 Nearly a Senior Poster Featured Poster

Or you can do this way :

Add Class to your project, named ListViewColumnSorter (You can modify it).
Replace with this following code :

Imports System.Collections
Imports System.Windows.Forms

Public Class ListViewColumnSorter
    Implements System.Collections.IComparer

    Private ColumnToSort As Integer
    Private OrderOfSort As SortOrder
    Private ObjectCompare As CaseInsensitiveComparer

    Public Sub New()
        ' Initialize the column to '0'.
        ColumnToSort = 0

        ' Initialize the sort order to 'none'.
        OrderOfSort = SortOrder.None

        ' Initialize the CaseInsensitiveComparer object.
        ObjectCompare = New CaseInsensitiveComparer()
    End Sub

    Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare
        Dim compareResult As Integer
        Dim listviewX As ListViewItem
        Dim listviewY As ListViewItem

        ' Cast the objects to be compared to ListViewItem objects.
        listviewX = CType(x, ListViewItem)
        listviewY = CType(y, ListViewItem)

        ' Compare the two items.
        compareResult = ObjectCompare.Compare(listviewX.SubItems(ColumnToSort).Text, listviewY.SubItems(ColumnToSort).Text)

        ' Calculate the correct return value based on the object 
        ' comparison.
        If (OrderOfSort = SortOrder.Ascending) Then
            ' Ascending sort is selected, return typical result of 
            ' compare operation.
            Return compareResult
        ElseIf (OrderOfSort = SortOrder.Descending) Then
            ' Descending sort is selected, return negative result of 
            ' compare operation.
            Return (-compareResult)
        Else
            ' Return '0' to indicate that they are equal.
            Return 0
        End If
    End Function

    Public Property SortColumn() As Integer
        Set(ByVal Value As Integer)
            ColumnToSort = Value
        End Set

        Get
            Return ColumnToSort
        End Get
    End Property

    Public Property Order() As SortOrder
        Set(ByVal Value As SortOrder)
            OrderOfSort = Value
        End Set

        Get
            Return OrderOfSort
        End Get
    End Property
End Class

In your form :

Public …
Sawamura commented: Great example +4
Jx_Man 987 Nearly a Senior Poster Featured Poster

You will get this error because using of Val() function.
e.g : Val(txtbox_tolagoldweight.Text * 96), you just multiply string with number.

try this :

Sub kaat()
    goldkaatinratti = (((Val(TextBox1.Text) * 96) + (Val(TextBox2.Text) * 8)) + (Val(TextBox3.Text) * 8)) / 96
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

Have you ever heard about BeginTrans,CommitTrans and RollbackTrans?
You can do this with Rollback.
Search the google about it.
See this article, this article, this and this.

dnk commented: Good links sir. very helpful +2
Jx_Man 987 Nearly a Senior Poster Featured Poster

do you know how to make pause button? i already try to make it after i click play button the song will not continue but it will be restart. this is my code for pause button.

You need to check what is the wmp state. Simple logic here. If state is pause then play the current song else play the selected song.
This is the modification of PlaySong Procedure :

Private Sub PlaySong()
    If ListBox1.Items.Count > 0 Then
        If Player.playState = WMPLib.WMPPlayState.wmppsPaused Then
            Player.Ctlcontrols.play()
        Else
            Player.URL = TextBox1.Text & "\" & ListBox1.SelectedItem
            flag = True
        End If
    End If
End Sub

the same logic applies to the pause button. If state is pause then play the current song else pause the song.
Here is the code:

 Private Sub Pause_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Pause.Click
    If Player.playState = WMPLib.WMPPlayState.wmppsPaused Then
        Player.Ctlcontrols.play()
    Else
        Player.Ctlcontrols.pause()
    End If
End Sub

Hope it solve your problem

Sawamura commented: Lots answer huh.. Why don't you make repeat or shufle function too :) +4
Jx_Man 987 Nearly a Senior Poster Featured Poster

Look at line 7:
Result= Sale*0,04
It must be :
Result= Sale*0.04

Also Commition variable is not used. Just remove it.

ddanbe commented: Fine eye! +14
Jx_Man 987 Nearly a Senior Poster Featured Poster

Okay.. We need boolean variable here to handle what section now.

' Declare flag as global variable
Dim flag As Boolean = True

...


Private Sub PlaySong()
    AxWindowsMediaPlayer1.URL = TextBox1.Text & "\" & ListBox1.SelectedItem
    flag = True
End Sub

Private Sub NextSong()
   If flag = True Then
        If AxWindowsMediaPlayer1.playState = WMPLib.WMPPlayState.wmppsStopped Then
            ListBox1.SetSelected(ListBox1.SelectedIndex + 1, True)
            AxWindowsMediaPlayer1.URL = TextBox1.Text & "\" & ListBox1.SelectedItem
        End If
    End If
End Sub

Private Sub PlayButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PlayButton.Click
    PlaySong()
End Sub

Private Sub StopButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles StopButton.Click
    flag = False
    AxWindowsMediaPlayer1.Ctlcontrols.stop()
End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
    NextSong()
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

Use Select Statement.
e.g : "Select Holder_name, Balance from Account where Account_Number = '" & Textbox1.Text & "'"

ahudson commented: Thank You very much +0
Jx_Man 987 Nearly a Senior Poster Featured Poster

To play next song :

Private Sub AxWindowsMediaPlayer1_PlayStateChange(ByVal sender As Object, ByVal e As AxWMPLib._WMPOCXEvents_PlayStateChangeEvent) Handles AxWindowsMediaPlayer1.PlayStateChange
    If AxWindowsMediaPlayer1.playState = WMPLib.WMPPlayState.wmppsStopped Then
        ListBox1.SetSelected(ListBox1.SelectedIndex + 1, True)
        AxWindowsMediaPlayer1.URL = TextBox1.Text & "\" & ListBox1.SelectedItem
    End If
End Sub
Hazuan Nazri commented: Thanks! +0
Jx_Man 987 Nearly a Senior Poster Featured Poster

Sorry, I mean this line :
AxWindowsMediaPlayer1.URL = TextBox1.Text & "\" & ListBox1.SelectedItem

Hazuan Nazri commented: Nice!! Thanks! +1
Jx_Man 987 Nearly a Senior Poster Featured Poster

You can use this following code :

Private Sub Form_Load()
    If Dir$("D:\dani.txt", vbNormal) = "" Then
        MsgBox "This is your first time"
    Else
        ' Do anything if text file exist
    End If
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

This should working :

Private Sub Command1_Click()
For Each ctl In Me.Controls
    If TypeOf ctl Is CheckBox Then
        If ctl.Value = vbChecked Then
            MsgBox ctl.Name
        End If
    End If
Next
End Sub
Vixion commented: never think about this in my program. very useful function and svae my times. +0
Jx_Man 987 Nearly a Senior Poster Featured Poster

This is how to find the real roots using Newton’s method:

Function realCubeRoot(a, b, c, d, n)
    '
    ' computes the nth real root of the cubic equation
    '
    ' a x^3 + b x^2 + c x + d = 0
    '
    ' =================================================
    xold = 1
    iter = 0
    Do
        iter = iter + 1
        f = a * xold ^ 3 + b * xold ^ 2 + c * xold + d
        df = 3 * a * xold ^ 2 + 2 * b * xold + c
        xnew = xold - f / df
        Err = xnew - xold
        xold = xnew
    Loop While (iter < 1000) And (Abs(Err) > 0.000001)
    If n = 1 Then
        realCubeRoot = xnew
    Else
        aa = b / a
        bb = c / a
        Real = -(aa + xnew) / 2
        Disc = (-3 * xnew ^ 2 - 2 * aa * xnew + aa ^ 2 - 4 * bb)
        If Disc < -0.0000001 Then
            realCubeRoot = "NA"
        Else
            Disc = Abs(Disc)
            If n = 2 Then
                realCubeRoot = Real + Disc ^ (1 / 2) / 2
            Else
                realCubeRoot = Real - Disc ^ (1 / 2) / 2
            End If
        End If
    End If
End Function

Private Sub Command1_Click()
    MsgBox realCubeRoot(5, 2, 2, 4, 1)
End Sub
Estella commented: Helping as always. +4
Jx_Man 987 Nearly a Senior Poster Featured Poster

I want it in 4 columns (First name, last name, age and blood type).
There are 4 arrays that i want it to written in list view but the point is how i can read it form text file and use listview to show it.

This should working :

Private Sub Command1_Click()
Dim temp() As String

temp = Split(ReadFileText("D:\Mid Task\Data.txt"), vbNewLine)

With ListView1
    .View = lvwReport
    .FullRowSelect = True
    .ColumnHeaders.Add , , "First Name", 1100
    .ColumnHeaders.Add , , "Last Name", 1400
    .ColumnHeaders.Add , , "Age", 700
    .ColumnHeaders.Add , , "Blood Type", 1000


    With .ListItems
        .Clear
        For i = 0 To UBound(temp)
            temp2 = Split(temp(i), ";")

            Set lsvItem = .Add(, , temp2(0))
            lsvItem.SubItems(1) = temp2(1)
            lsvItem.SubItems(2) = temp2(2)
            lsvItem.SubItems(3) = temp2(3)

        Next i
    End With

End With

I think you don't have to use another arrays. Read data to temp array and write it to listview.

Hope it helps.

Sturdy commented: Thanks for the code +1
Jx_Man 987 Nearly a Senior Poster Featured Poster

Try this :

Private Sub Form_Load()
    Dim Conn As New ADODB.Connection
    Dim rs As ADODB.Recordset

    Set Conn = New ADODB.Connection
    Conn.Provider = "Microsoft.ACE.OLEDB.12.0"
    Conn.CursorLocation = adUseClient
    Conn.Open "D:\database.accdb"

    Set rs = New ADODB.Recordset
    rs.Open "select * from mytable", Conn, adOpenDynamic, adLockBatchOptimistic

    While Not rs.EOF
        Combo1.AddItem rs!name
        rs.MoveNext
    Wend
    rs.Close

End Sub
imBaCodes commented: nice.. +3
Jx_Man 987 Nearly a Senior Poster Featured Poster

I already build a program with vb6. The problem is when the program is running and user click the exe file again then it makes program running twice in same time.
Is there a way to restrict this happened?

Something like this should working :

Private Sub Form_Load()
    If App.PrevInstance = True Then
        MsgBox "Application is running!", vbExclamation, "Warning"
        End
    End If
End Sub
november_pooh commented: Very simple code but worked great!! +3
Jx_Man 987 Nearly a Senior Poster Featured Poster

A positive attitude may not solve all your problems, but it will annoy enough people to make it worth the effort.

Jx_Man 987 Nearly a Senior Poster Featured Poster

dIndex = myText.IndexOf("|")
...
So, is there a "length" command to find the total number of characters in the string?

To get total character/length :

sLength = myText.Length

But if you want to get string after | sign then you can use substring function :

PrinterId = myText.Substring(myText.IndexOf("|") + 1)
Sawamura commented: +1 +4
Jx_Man 987 Nearly a Senior Poster Featured Poster

Something like this should working :

Function ReadFileText(ByVal filename As String) As String
        Dim handle As Integer

           ' ensure that the file exists
        If Len(Dir$(filename)) = 0 Then
            Err.Raise 53  ' File not found
        End If

           ' open in binary mode
        handle = FreeFile
        Open filename$ For Binary As #handle
           ' read the string and close the file
        ReadFileText = Space$(LOF(handle))
        Get #handle, , ReadFileText
        Close #handle
End Function

Private Sub Command1_Click()
Dim temp() As String
Dim temp2() As String
Dim FNArr() As String
Dim LNArr() As String
Dim AgeArr() As String
Dim BloddArr() As String

    ' split text file by new line (enter)
    temp = Split(ReadFileText("D:\Dani.txt"), vbNewLine)

    ' get how many rows in array
    x = UBound(temp) 

    ' redim each array with new rows. 
    ReDim FNArr(x)
    ReDim LNArr(x)
    ReDim AgeArr(x)
    ReDim BloddArr(x)

    For i = 0 To x
        ' split each line by semicolon sign
        temp2 = Split(temp(i), ";")

        ' write each data to proper arrays
        FNArr(i) = temp2(0)
        LNArr(i) = temp2(1)
        AgeArr(i) = temp2(2)
        BloddArr(i) = temp2(3)
    Next i

End Sub
Sturdy commented: Thanks for the great code sir. +1
Jx_Man 987 Nearly a Senior Poster Featured Poster

so, What wrong with your code? any errors?
What you mean about "particular pattern"?
Post your text file sample.

Jx_Man 987 Nearly a Senior Poster Featured Poster

DLP/001/2013-2014
DLP/002/2013-2014
DLP/003/2013-2014

I don't recomended to make autonumber to an Id like this but you can split it.
Get the Last Invoice number from database and Split it by "/". Extract the second value in array and you will get the existing invoice num. Add it by 1 and there are new Invoice Num.
Ex :

Private Sub InvoiceNum()
    Set rs = New ADODB.Recordset
    ' Select last row data using MAX() function
    rs.Open "SELECT max(Id)from Address", Conn, adOpenDynamic, adLockBatchOptimistic

    Dim temp() As String
    temp = Split(rs.Fields(0), "/") 'Split data by "/" sign
    ' temp (0) will contain DLP
    ' temp (1) will contain 003
    ' temp (2) will contain 2013-2014

    MsgBox "DLP/00" & temp(1) + 1 & "/2013-2014" ' Show new invoice number 
    rs.Close
End Sub
ITKnight commented: . +2
Jx_Man 987 Nearly a Senior Poster Featured Poster

What's makes me get bad rep here?

Estella commented: Just random member.. take it easy +4
Jx_Man 987 Nearly a Senior Poster Featured Poster

Try :
SendKeys "%s"

Read this for more information

Sawamura commented: Good link +4
Jx_Man 987 Nearly a Senior Poster Featured Poster

As TnTinMN suggested. You can try AlternatingRowsDefaultCellStyle. The value for alternating rows overrides the value for all rows.

Just two lines code :

    DataGridView1.RowsDefaultCellStyle.BackColor = Color.LightBlue  'Or you can use: DataGridView1.DefaultCellStyle.BackColor = Color.LightBlue
    DataGridView1.AlternatingRowsDefaultCellStyle.BackColor = Color.LemonChiffon
Estella commented: Great example +4
Jx_Man 987 Nearly a Senior Poster Featured Poster

Try :

    For i As Integer = 0 To DataGridView1.RowCount - 1
        If DataGridView1.Rows(i).Index Mod 2 = 0 Then
            DataGridView1.Rows(i).DefaultCellStyle.BackColor = Color.LightBlue
        Else
            DataGridView1.Rows(i).DefaultCellStyle.BackColor = Color.LemonChiffon
        End If
    Next i
TnTinMN commented: That works, but why not use AlternatingRowsDefaultCellStyle? +8
Jx_Man 987 Nearly a Senior Poster Featured Poster

Try this :
Add 1 Command Button to your form.
Add 1 reference to Microsoft Excel 12.0 Object Library
Project -> References -> mark the Microsoft Excel 12.0 Object Library

Private Sub Command1_Click()

    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlWS As Excel.Worksheet

    Set xlApp = New Excel.Application
    Set xlWB = xlApp.Workbooks.Add
    Set xlWS = xlWB.Worksheets.Add

' This following lines will fill the cell (2,2) with the text "hello",
' and will fill the cell (1,3) with the text "World"
    xlWS.Cells(2, 2).Value = "hello"
    xlWS.Cells(1, 3).Value = "World"

' The following line saves the spreadsheet to "c:\mysheet.xls" file.
    xlWS.SaveAs "D:\mysheet.xls"
    xlApp.Quit

' Free memory
    Set xlWS = Nothing
    Set xlWB = Nothing
    Set xlApp = Nothing

End Sub
Naruse commented: agree +3
Jx_Man 987 Nearly a Senior Poster Featured Poster

Try :

Private Sub Command1_Click()
If Dir$("D:\Daniweb\", vbDirectory) = "" Then
    MkDir "D:\Daniweb\"
Else
    MsgBox "Duplicate Folder"
End If
End Sub

Private Sub Command2_Click()
If Dir$("D:\Daniweb\", vbDirectory) = "" Then
    MsgBox "Folder not found"
Else
    RmDir "D:\Daniweb\"
End If
End Sub
Aurax commented: Help me too +0
Jx_Man 987 Nearly a Senior Poster Featured Poster

I change "ID" as "No" in my project. So, user can be easily know how many rows are there.

Why you don't count listview items to show it? it's more easy than user have to drag over the 1000 lines of records.

You know I need to update row "No" and "Background Color" Whenever user deletes any row

No one of control (datagrid,listview,flexgrid,etc) can't handling "No" update. When you remove 1 record, it will completely remove entire data in selected row.

I also add "Edit" button to update one of the fields.When user finish the editing, I will change the background color for related rows.

You can manipulate forecolor and bold to mark edited rows.

There is new codes for what you wants :
You can delete any rows without worrying the number of records.
After editing selected row will change forecolor to Red and set as Bold

Private Sub SetListview()
' Set listview
With ListView1
    .View = lvwReport
    .FullRowSelect = True
    .ColumnHeaders.Add , , "Id", 1100
    .ColumnHeaders.Add , , "First Name", 1400
    .ColumnHeaders.Add , , "Last Name", 1400
    .ColumnHeaders.Add , , "Email", 1700
End With

' Insert Data
With ListView1.ListItems
    .Add , , "1"
    .Item(1).SubItems(1) = "Andre"
    .Item(1).SubItems(2) = "White"
    .Item(1).SubItems(3) = "Andre@White.com"

    .Add , , "2"
    .Item(2).SubItems(1) = "Danny"
    .Item(2).SubItems(2) = "Burnett"
    .Item(2).SubItems(3) = "Danny@Burnett.com"

    .Add , , "3"
    .Item(3).SubItems(1) = "Edward"
    .Item(3).SubItems(2) = "Carter"
    .Item(3).SubItems(3) = "Edward@Carter.com"

    .Add , , "4"
    .Item(4).SubItems(1) = "Anne"
    .Item(4).SubItems(2) = "Witter"
    .Item(4).SubItems(3) …
Jade_me commented: This is awesome dude..wan't to try it.. +2
Jx_Man 987 Nearly a Senior Poster Featured Poster

Make sure you have one more row for sum of amount

Try :

    Dim temp As Integer
    temp = 0

    For i = 1 To MSFlexGrid1.Rows - 1
        temp = temp + Val(MSFlexGrid1.TextMatrix(i, 4))
    Next i

    'set sum of amount to last row
    MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 4) = temp

af5176f21877f429286df1edb1c3361b

november_pooh commented: Nice +3
Jx_Man 987 Nearly a Senior Poster Featured Poster

Try :

Private Sub ListView1_Click()
    Dim a, b, c, d As String
    Dim index As Integer

    index = ListView1.SelectedItem.index

    a = ListView1.ListItems(index).Text
    b = ListView1.ListItems(index).SubItems(1)
    c = ListView1.ListItems(index).SubItems(2)
    d = ListView1.ListItems(index).SubItems(3)

    'Set textboxes in form2 with value from listview
    Form2.Text1.Text = a
    Form2.Text2.Text = b
    Form2.Text3.Text = c
    Form2.Text4.Text = d

    Form4.Show
End Sub
november_pooh commented: Great +3
Jx_Man 987 Nearly a Senior Poster Featured Poster

If I want to leave the date field blank, would that be a "NULL", or is there another entry that should be used?

You can use SqlDateTime.Null.
Read this : http://msdn.microsoft.com/en-us/library/system.data.sqltypes.sqldatetime.null%28v=vs.80%29.aspx

Dim DateVal As SqlDateTime
DateVal = SqlDateTime.Null
cmd.Parameters("@Date").Value = DateVal

Also, since this is entered into a textbox, is there a date conversion that is required to write this to the data table?

cmd.Parameters("@Date").Value = DateTime.Parse(txtDate.Text)

Jx_Man 987 Nearly a Senior Poster Featured Poster

Example : This code trying to load data from mysql and show it in datagrid.
Just try it. Lookout for user and password.

  1. add reference : Project -> Reference -> Microsoft ActiveX Data Objects 6.0 Library
  2. add component (datagrid) : Project -> Component -> Microsoft Windows Common Controls 6.0 (SP6)

Add Datagrid and button to form then write this following code :

Public Conn As New ADODB.Connection
Public rs As New ADODB.Recordset

Public Sub Connect()
    Dim ConnString As String
    Dim db_name As String
    Dim db_server As String
    Dim db_port As String
    Dim db_user As String
    Dim db_pass As String
    ' error traping
    On Error GoTo Connection_Error
    ' fill the variable
    db_name = "Address" 'database name
    db_server = "localhost" '
    db_port = "3306"    'default port is 3306
    db_user = "root"    'default user name.
    db_pass = ""  ' depend on your password on mysql
    '/Create connection string
    ConnString = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & db_server & ";DATABASE=" & db_name & ";UID=" & db_user & ";PWD=" & db_pass & ";PORT=" & db_port & ";OPTION=3"
    '/Open Connection
    With Conn
        .ConnectionString = ConnString
        .Open
    End With

    On Error GoTo 0
    Exit Sub

Connection_Error:
        MsgBox "Err Desc : " & Err.Description & Chr(13) & "Err Source : " & Err.Source, vbInformation, "Error"
End Sub

Private Sub Command1_Click()
    rs.CursorLocation = adUseClient
    rs.Open "SELECT * FROM AddressData", Conn, adOpenDynamic, adLockBatchOptimistic
    Set DataGrid1.DataSource = rs
End Sub

Private Sub Form_Load()
' connect when form loaded
Connect

End Sub

e421380732cc095d6a5617cec9470669

which …

Neji commented: Great example +2
Jx_Man 987 Nearly a Senior Poster Featured Poster

the link you gave there , it has a code there.. is that used in linking the database to the frontend?

Yes, a code for linking vb6 with Mysql but just few lines.
This is an example of connection vb6 with mysql:

Dim Conn As New ADODB.Connection
Dim ConnString As String
Dim db_name As String
Dim db_server As String
Dim db_port As String
Dim db_user As String
Dim db_pass As String

' fill the variable
db_name = "Address"
db_server = "localhost" '
db_port = "3306"    'default port is 3306
db_user = "root"    'default user name.
db_pass = ""  ' depend on your password on mysql
'/Create connection string
ConnString = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & db_server & ";DATABASE=" & db_name & ";UID=" & db_user & ";PWD=" & db_pass & ";PORT=" & db_port & ";OPTION=3"
'/Open Connection
With Conn
    .ConnectionString = ConnString
    .Open
End With

but in our class , they linked it without any code , an excerpt from my notes says

Yes, you can connect to mysql without code but using code and variable make your program flexible and can run in any computers.

Jx_Man 987 Nearly a Senior Poster Featured Poster

1.Read this
2. You can compare date function using DateTime.Compare(date1, date2)
Ex :

    Dim date1 As Date = #08/01/2009 12:00AM#
    Dim date2 As Date = #08/01/2009 12:00PM#
    Dim result As Integer = DateTime.Compare(date1, date2)
    Dim relationship As String 

    If result < 0 Then
       relationship = "is earlier than" 
    ElseIf result = 0 Then
       relationship = "is the same time as"          
    Else
       relationship = "is later than" 
    End If

    Console.WriteLine("{0} {1} {2}", date1, relationship, date2)
    ' The example displays the following output: 
    '    8/1/2009 12:00:00 AM is earlier than 8/1/2009 12:00:00 PM

More info : MSDN and this article

3.It's depend on your region. By default, the date format for SQL server is in U.S. date format MM/DD/YY.
Read this

Jx_Man 987 Nearly a Senior Poster Featured Poster

I Want to Check How Much PC's Are Connected On My LAN,

http://www.daniweb.com/software-development/vbnet/threads/310040/how-to-view-computers-connected-to-a-local-network

also if I Call The Database From Server PC to Client PC Then What Should be The Connection String

What kind of database?
Access : http://www.connectionstrings.com/access-2007
sql server 2008 : http://www.connectionstrings.com/sql-server-2008
More info http://www.connectionstrings.com/

Jx_Man 987 Nearly a Senior Poster Featured Poster

'is there any code like this?
userform1.input_date.value = userform1.input_date.lastValue

Nope.. I don't think it exist

i have a form and i have 2 input box.
Is there any way to restore the last input in reopening the Form.

You can save it into text file and access it whenever you need

Jx_Man 987 Nearly a Senior Poster Featured Poster

Try this :

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    w = Picture1.Point(X, Y)
    R = w And RGB(255, 0, 0)

    G = Int((w And RGB(0, 255, 0)) / 256)
    B = Int(Int((w And RGB(0, 0, 255)) / 256) / 256)
    labelR.Caption = R
    labelR.Caption.Text = G
    labelR.Caption.Text = B
End Sub
Naruse commented: Thank you :) +3
Jx_Man 987 Nearly a Senior Poster Featured Poster

where can i put table headers, this code will loop on selected record on the table

Just add one row when you create a table.
Set SIATable = SIADoc.Tables.Add(SIADoc.Bookmarks("\endofdoc").Range, rs.RecordCount + 1, 7)

Fill first row with Column name before you get a data thorugh the looping.

        '....

        ' heading
        SIATable.Cell(0, 1).Range.Text = "Column 1"
        SIATable.Cell(0, 2).Range.Text = "Column 2"
        SIATable.Cell(0, 3).Range.Text = "Column 3"
        SIATable.Cell(0, 4).Range.Text = "Column 4"
        SIATable.Cell(0, 5).Range.Text = "Column 5"
        SIATable.Cell(0, 6).Range.Text = "Column 6"
        SIATable.Cell(0, 7).Range.Text = "Column 7"

        ' Fill other rows with data from database
        For siar = 2 To rs.RecordCount + 1
            siac = 1 To 7
                SIATable.Cell(siar, siac).Range.Text = rs(siac - 1).Value
                SIATable.Rows(siar).Range.Font.Size = 9
                SIATable.Rows(siar).Range.Font.Bold = False
            Next
        .MoveNext
        Next

how can i add date and time on the filename: SIADoc.SaveAs ("C:\Users\2mhzbrain\Desktop\Main Inventory - '"& DATE + TIME &"'.docx") this is not working, but this is what i want to happen on the file names. thanks

You can't do it with date and time.
Date and Time will return illegal string for file name.
Date = 4/2/2013
TIme = 12:36:53 PM
Windows will reject this character: \/:*?"<>

Jade_me commented: Nice. +2
Jx_Man 987 Nearly a Senior Poster Featured Poster

Currently, I have 3 listboxs' data, but I don't know how to create 3 columns and show them with datagrid control.
Does anyone give me a guid line how to show listbox's data with datagrid?

You can fill recordset with listbox items then you can set datagrid source with current recordset.

see this example :

Private Sub Command1_Click()
Dim rsTest As New ADODB.Recordset

' create new column in recordset named listbox1, listbox2, listbox3
' every column has unique name

With rsTest.Fields
.Append "Listbox1", adBSTR
.Append "Listbox2", adBSTR
.Append "Listbox3", adBSTR
End With

rsTest.Open
For i = 0 To List1.ListCount

' add every listbox items into each column

    With rsTest
        .AddNew
        .Fields("Listbox1") = List1.List(i)
        .Fields("Listbox2") = List2.List(i)
        .Fields("Listbox3") = List3.List(i)
        .Update
    End With
Next i

Set DataGrid1.DataSource = rsTest
End Sub

Private Sub Form_Load()
With List1
    For i = 1 To 10
        .AddItem i
    Next i
End With

With List2
    For j = 11 To 20
        .AddItem j
    Next j
End With

With List3
    For k = 21 To 30
        .AddItem k
    Next k
End With

End Sub

1da39ad35d02cd7d27315d1fb6cad87f

TnTinMN commented: nice example +8
Jx_Man 987 Nearly a Senior Poster Featured Poster

Declare object instance of form2 and use it to disable or visble a button in form2.
You already declare it but you didn't use it.
Try this :

Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
    Dim form2 As New Form2
    form2.SaveVISACaseButton.Enabled = False
    form2.SaveVISACaseButton.Visible = False
    form2.Show()
    Me.Hide()
End Sub
november_pooh commented: Nice. +2
Jx_Man 987 Nearly a Senior Poster Featured Poster
Estella commented: Nice site +3
Jx_Man 987 Nearly a Senior Poster Featured Poster

Try This :

Public Conn As New ADODB.Connection
Private Sub Access_Connector()
    Set Conn = New ADODB.Connection
    Conn.Provider = "microsoft.jet.oledb.4.0"
    Conn.CursorLocation = adUseClient
    Conn.Open App.Path & "\project.mdb"
End Sub
Private Sub GetData()
    Set rs = New ADODB.Recordset
    rs.Open "SELECT * from goods ", Conn, adOpenDynamic, adLockBatchOptimistic

    While Not rs.EOF
        List1.AddItem rs.Fields("tabid")
        rs.MoveNext
    Wend
    rs.Close
End Sub

Private Sub Command1_Click()
    Dim temp As String
    Text1.Text = ""
    For i = 0 To List1.ListCount - 1
        If List1.Selected(i) = True Then
            temp = temp & List1.List(i) & ","
        End If
    Next

    Set rs = New ADODB.Recordset
    rs.Open "SELECT * from goods where tabid in (" & temp & ")", Conn, adOpenDynamic, adLockBatchOptimistic

    While Not rs.EOF
        Text1.Text = Text1.Text & rs.Fields!tabid & "-" & rs.Fields("tabno") & vbCrLf
        rs.MoveNext
    Wend
    rs.Close
End Sub

Private Sub Form_Load()
Access_Connector
GetData
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

If it textbox you can use ascii to trap zero and negative sign.

Private Sub Text1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 45, 48  
    KeyAscii = 0
End Select
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

Hai Haviansyah..
As andre said that your code is not consistent.
Ex when you use text1 instead of Name.
But we really appreciate your post and hope many posts from you. :)

*NB : Pake bhs inggris ya bro,,forum internasional nih,,hehe,,semua comment n bhs harus inggris,,ntar pada komentar,,kdg ada admin yg mrh kalo bukan bhs ing.. see u soon bro :)

AndreRet commented: Long time no hear ;) +12
Aurax commented: :D +0
Jx_Man 987 Nearly a Senior Poster Featured Poster

1 Textbox, 1 Button. Result showing in form caption :

Private Sub Command1_Click()
    Dim TextLines As Variant
    TextLines = Split(Text1, vbNewLine)
    Form1.Caption = "Sockz-" & (UBound(TextLines) + 1)
End Sub
debasisdas commented: agree +13
Naruse commented: agree +2
Sturdy commented: :D +1
Jx_Man 987 Nearly a Senior Poster Featured Poster

You can capture the form resizing event then set the form into normal size.

Private Sub Form_Resize()
    If (Me.WindowState <> vbMinimized) Then
        Me.Width = 4800
        Me.Height = 3600
    End If
End Sub

And set max button to false.