Subscribe to andrewsw's Blog        RSS Feed
***** 1 Votes

VB.NET Code Samples

Icon 1 Comments
Here presented for your delight is a wall of VB.NET code. These are code samples and fragments I have collected over a length of time, some of which have appeared in the Snippets section.

Initially, it lists code by the name of the Control it demonstrates but thereafter it loses some order. Personally, I search a keyword or control name to find what I'm looking for.

There are fairly limited comments as it wasn't intended for public perusal ;) although it should be self-documenting anyway.

'VB.NET Code Samples

CheckedListBox Control

	'Toggle Checked/Unchecked CheckState
	For i As Integer = 0 To CheckedListBox1.Items.Count - 1
		Dim state As CheckState = CheckedListBox1.GetItemCheckState(i)
		If state = CheckState.Checked Then
			state = CheckState.Unchecked
			state = CheckState.Checked
		End If
		CheckedListBox1.SetItemCheckState(i, state)

'ComboBox Control

    Private Sub ComboBox1_SelectedIndexChanged(sender As Object, e As EventArgs) _
            Handles ComboBox1.SelectedIndexChanged
        MessageBox.Show("You selected " & ComboBox1.SelectedItem.ToString())
    End Sub
	'cf SelectionchangeCommitted:
	"Occurs when the user changes the selected item and that change is displayed in the ComboBox."

	'Yes and No as 1 and 0:
	Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        ComboBox1.DataSource = {New With {.Choice = "No", .Represents = 0},
                                New With {.Choice = "Yes", .Represents = 1}}
        ComboBox1.DisplayMember = "Choice"
        ComboBox1.ValueMember = "Represents"
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        If ComboBox1.SelectedValue IsNot Nothing Then
			'or just set DropDownStyle to DropDown
        End If
    End Sub
	ComboBox1.DataSource = {"Pears", "Bananas", "Grapes", "Apples"}
	ComboBox1.Items.AddRange({2000, 2001, 2002})
	ComboBox1.Items.AddRange({Enumerable.Range(2000, 16).ToArray})
	ComboBox1.DataSource = Enumerable.Range(2000, 16).ToList()

	'a more complete example using DisplayMember and ValueMember, and SelectedItem
	Public Class Form1
		Private _people As New List(Of Person)

		Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
			_people.Add(New Person With {.FirstName = "Bob", .Age = 23, .NickName = "Bobby"})
			_people.Add(New Person With {.FirstName = "Fred", .Age = 24, .NickName = "Freddy"})

			cboPerson.DataSource = _people
			cboPerson.DisplayMember = "FirstName"
			cboPerson.ValueMember = "Age"
		End Sub

		Private Sub cboPerson_SelectionchangeCommitted(sender As Object, e As EventArgs) _ 
				Handles cboPerson.SelectionchangeCommitted
			If cboPerson.SelectedIndex <> -1 Then
				MessageBox.Show(CType(cboPerson.SelectedItem, Person).NickName)
			End If
		End Sub

		Class Person
			Property FirstName As String
			Property Age As Integer
			Property NickName As String
		End Class
	End Class


	'Looping through specific controls
	For Each tb As TextBox In Me.Controls.OfType(Of TextBox)(). _
			Where(Function(x) x.Tag = "Something")
	'Loop through ALL controls, recursive
	'(or could use GetNextControl, which uses the TabIndex)
    Sub AllControls(ByRef ctl As Control)
        For Each aCtl In ctl.Controls
            If aCtl.HasChildren Then
                Call AllControls(aCtl)
            End If
    End Sub
	'Check if any TextBoxes are empty
	Private Sub SetButton1()
		btnSubmit.Enabled = True
		Dim empties = Me.Controls.OfType(Of TextBox)().Where(Function(x) x.Text = "").Count()
		If empties > 0 Then
			btnSubmit.Enabled = False
		End If
	End Sub
	'.. or from an array of TextBoxes
	Dim texts() = {TextBox1, TextBox2, TextBox3}

	btnSubmit.Enabled = Not texts.Where(Function(x) x.Text = "").Any()
	btnSubmit.Enabled = Not texts.Any(Function(x) x.Text = "")
	'Checking controls in pairs (by similar name)
	Dim clipbd As String = ""

	For Each cb As CheckBox In Me.Controls.OfType(Of CheckBox)()
		If cb.Name.StartsWith("ckb") AndAlso cb.Checked Then
			Dim sTextName As String = cb.Name.Replace("ckb", "txt")
			Dim tb As TextBox = TryCast(Me.Controls(sTextName), TextBox)

			If Not tb Is Nothing AndAlso Not String.IsNullOrWhiteSpace(tb.Text) Then
				clipbd &= tb.Text & vbNewLine
			End If
		End If
	If Not String.IsNullOrWhiteSpace(clipbd) Then
	End If

'DataGridView Control

    Private Sub ResetDataGridView()
        dataGridView1.DataSource = Nothing
    End Sub

	'Setting default value(s)
    Private Sub dgvFieldList_DefaultValuesNeeded(sender As Object, e As DataGridViewRowEventArgs) _
            Handles dgvFieldList.DefaultValuesNeeded
        e.Row.Cells(1).Value = "System.String"
    End Sub
	'change header style and color
	Private Sub frmExcel_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        dgvExcel.EnableHeadersVisualStyles = False

        dgvExcel.ColumnHeadersDefaultCellStyle = New DataGridViewCellStyle With {
            .Font = New Font(dgvExcel.Font, FontStyle.Bold),
            .ForeColor = Color.Red
    End Sub

	'toggle all other checkboxes in column
    Private Sub DataGridView1_CellContentClick(sender As Object, e As DataGridViewCellEventArgs) _
            Handles DataGridView1.CellContentClick

        If e.ColumnIndex <> 0 Then
			'better is
			'If e.ColumnIndex <> DataGridView1.Columns("PK").Index Then
            Exit Sub    'it's not the checkbox
        End If
        'how to store the NEW state of the checkbox
        Dim state = CType(DataGridView1.Rows(e.RowIndex).Cells(0).EditedFormattedValue, Boolean)

        For Each row As DataGridViewRow In DataGridView1.Rows
            If row.Index <> e.RowIndex Then
                row.Cells(0).Value = False
            End If
    End Sub
'Form Control


    Public Class Form1
        Private WithEvents frm2 As Form2

        Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) _
                Handles Me.FormClosed

            For Each frm As Form In Application.OpenForms
        End Sub
        'on a click event:
        frm2 = New Form2
        'another way to add event handler
        AddHandler frm2.FormClosed, Sub(s, e2) doThis(s, e2)
        Private Sub Form2_Closed(sender As Object, e As Windows.Forms.FormClosedEventArgs) _
                Handles frm2.FormClosed
        End Sub

'Form Control - centre cursor

	Windows.Forms.Cursor.Position = New Point( _ 
		Location.X + Me.Width / 2, Location.Y + Me.Height / 2)

'Form Control (Dialog)

    Relevant properties:
    FormBorderStyle, MinimizeBox, MaximizeBox, StartPosition, ShowInTaskbar,
    and DialogResult for buttons on the form.
'Form Control - MouseLeave

    Private Sub Form1_MouseLeave(sender As Object, e As EventArgs) Handles MyBase.MouseLeave
        Dim pt = PointToClient(Cursor.Position)
        If Not ClientRectangle.Contains(pt) Then
            'mouse has left the form
        End If
    End Sub

'GetProperty - check if controls have a named property

    For Each ctl As Control In Me.ContextMenuStrip1.Controls
        If ctl.GetType().GetProperty("ForeColor") IsNot Nothing Then
            ctl.ForeColor = Color.Aquamarine
        End If

'Image - save and load image from MS Access OLE Object field

Imports System.Data.OleDb

Public Class Form1

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim connection As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                              "Data Source=C:\Users\Andrew\Documents\Pictures.accdb;" & _
                                              "Persist Security Info=False;")
        Dim command As New OleDbCommand("INSERT INTO tblPictures (Picture, Description) VALUES (?, 'testing')", connection)

        Using picture As Image = Image.FromFile("C:\Users\Andrew\Pictures\coyote.jpg")
            Using stream As New IO.MemoryStream
                picture.Save(stream, Imaging.ImageFormat.Jpeg)
                command.Parameters.Add("Picture", OleDbType.VarBinary).Value = stream.GetBuffer()
            End Using
        End Using


    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Dim connection As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                              "Data Source=C:\Users\Andrew\Documents\Pictures.accdb;" & _
                                              "Persist Security Info=False;")
        Dim command As New OleDbCommand("SELECT Picture FROM tblPictures WHERE Description='testing'", connection)


        Dim pictureData As Byte() = DirectCast(command.ExecuteScalar(), Byte())


        Dim picture As Image = Nothing

        'Create a stream in memory containing the bytes that comprise the image.
        Using stream As New IO.MemoryStream(pictureData)
            'Read the stream and create an Image object from the data.
            picture = Image.FromStream(stream)
            PictureBox1.Image = picture
        End Using
    End Sub
End Class

'ListBox Control

    ListBox1.Items.AddRange({"Apples", "Pears", "Bananas"})
    Private Sub ListBox1_SelectedIndexChanged(sender As Object, e As EventArgs) _
            Handles ListBox1.SelectedIndexChanged
        Dim d As Integer

        For d = 0 To 4
        Next d
    End Sub
	If ListBox1.FindString("Apple") = -1 Then
		MessageBox.Show("Not found.")
	End If
'ListBox - some useful properties:
PreferredHeight - the combined height of all items
IntegralHeight - avoid showing partial items.

'ListBox - randomly remove items
	Private _rand As Random = New Random
	Dim iNext As Integer
	Label1.Text = ""
	For x As Integer = 1 To ListBox1.Items.Count
		iNext = _rand.Next(ListBox1.Items.Count)
		Label1.Text &= ListBox1.Items(iNext).ToString() & " "

'ListView Control

    Dim currentItem As Integer = ListView1.FocusedItem.Index

    'Adding an item - n.b. ListView1.View = Details
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim newItem As New ListViewItem(TextBox1.Text)
		'also SubItems.AddRange
    End Sub

'MouseMove Event

    Private Sub Form1_MouseMove(ByVal sender As System.Object, _ 
			ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
        'PictureBox1.Location = PointToClient(Cursor.Position)
		'The following code would need to be added to the picturebox's 
		'MouseMove event as well.
        Dim pt = PointToClient(Cursor.Position)
        pt.X = pt.X - PictureBox1.Width / 2
        pt.Y = pt.Y - PictureBox1.Height / 2
        PictureBox1.Location = pt
    End Sub

'NumericUpDown - up only

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Dim uppity As New UpOnly
        uppity.Value = 5
        uppity.ReadOnly = True      'cannot type number
    End Sub

	Public Class UpOnly : Inherits NumericUpDown
		Public Overrides Sub DownButton()
			Return      'don't do it!
		End Sub

		Public Overrides Sub UpButton()
		End Sub
	End Class

'Paint event/ drawing

	Public Class Form1
		'class-level variable
		Private bDrawEllipse As Boolean = False

		Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
			'trigger Paint event when Form is resized
			Me.SetStyle(ControlStyles.ResizeRedraw, True)
		End Sub

		Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
			Me.bDrawEllipse = Not Me.bDrawEllipse   'toggle the Ellipse
			Me.Refresh()    'immediately invalidate Form, triggering Paint event
		End Sub

		Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles MyBase.Paint
			If Not Me.bDrawEllipse Then
				'don't re-draw the ellipse, it will just disappear
			End If
			Dim g As Graphics = e.Graphics  'get Graphics context
			g.FillEllipse(Brushes.DarkBlue, Me.ClientRectangle)
		End Sub
	End Class

'Paint event, re-draw Rectangle within Form's region (ClientSize)
	Public Class Form1

		Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles MyBase.Paint
			Dim g = e.Graphics
			g.DrawRectangle(Pens.Red, New Rectangle(5, 5, _
				Me.ClientRectangle.Width - 10, Me.ClientRectangle.Height - 10))
		End Sub

		Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
			Me.ResizeRedraw = True
		End Sub
	End Class

'PictureBox - move image

	'It is preferable though, to ditch the PictureBox and just paint in a Panel
	'or on the Form's surface.
	Public Class Form1
		Private _moveIt As Boolean = False
		Private _coyote As Image

		Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
			_coyote = PictureBox1.Image
		End Sub
		Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
			_moveIt = True
		End Sub

		Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
			If _moveIt = True Then
				PictureBox1.Image = Nothing
				e.Graphics.DrawImage(_coyote, New Rectangle(New Point(32, 64), _
															New Size(_coyote.Width, _coyote.Height)))
			End If
		End Sub
	End Class

'PointToClient - detect if cursor inside form (client) rectangle

    Dim pt As Point = PointToClient(Cursor.Position)
    If ClientRectangle.Contains(pt) Then
        MessageBox.Show("Inside form..")
    End If

'RadioButton Control

    'Using as a group - first place in a GroupBox and, possibly,
    'within a Panel, if there are a set of (mutually exclusive) questions.
    Private m_Group1SelectedRadioButton As RadioButton

    Private Sub RadioButtonGroup1_CheckedChanged( _
            ByVal sender As Object, ByVal e As EventArgs) Handles _
            RadioButton1.CheckedChanged, RadioButton2.CheckedChanged, _

        Dim SourceControl As RadioButton = DirectCast(sender, RadioButton)
        If SourceControl.Checked Then
            m_Group1SelectedRadioButton = SourceControl
        End If
    End Sub

'RichTextBox Control

    'get the clicked line number
    Private Sub RichTextBox1_Click(sender As Object, e As EventArgs) _
            Handles RichTextBox1.Click
        Dim clickedLine As Integer = 0
        clickedLine = sender.GetLineFromCharIndex(sender.Selectionstart)

        MessageBox.Show(String.Format("You clicked line {0:d}", clickedLine))
    End Sub

    'add text at the end
    Me.RichTextBox1.Selectionstart = Me.RichTextBox1.TextLength
    Me.RichTextBox1.AppendText("some text")

    'colour found words
    Dim reg As Regex = New Regex("\bhello\b", RegexOptions.Multiline Or RegexOptions.IgnoreCase)
    Dim rtb As RichTextBox = RichTextBox1
    Dim mtchs As MatchCollection = reg.Matches(rtb.Text)
    'Dim mat As Match = mtchs.Item(i)
    For Each m As Match In mtchs
        rtb.Selectionstart = m.Index
        rtb.SelectionLength = m.Length
        rtb.SelectionColor = Color.CadetBlue
	'copy and Paste formatted (rtf) text between RTBs
	Clipboard.SetText(RichTextBox1.Rtf, TextDataFormat.Rtf)
	RichTextBox2.Select(RichTextBox2.TextLength - 1, 1)

	Dim myFormat As DataFormats.Format = DataFormats.GetFormat(DataFormats.Rtf)
	'merge the rtf of two RTBs, using a third RTB, and save
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim rich As RichTextBox = New RichTextBox()

        rich.Rtf = RichTextBox1.Rtf
        rich.Selectionstart = rich.TextLength
        rich.SelectionLength = 0
        rich.SelectedRtf = RichTextBox2.Rtf

        rich.SaveFile("C:\Users\Andrew\Documents\testrtf.docx", RichTextBoxStreamType.RichText)
    End Sub

'TableLayoutPanel Control

    'on initializing, paint alternate rows
    Private Sub TableLayoutPanel1_CellPaint(sender As Object, e As _ 
			TableLayoutCellPaintEventArgs) Handles TableLayoutPanel1.CellPaint
        If (e.Row = 0 Or e.Row = 2) Then
            Dim g As Graphics = e.Graphics
            Dim r As Rectangle = e.CellBounds
            g.FillRectangle(New SolidBrush(Color.Blue), r)
        End If
    End Sub


	Deselecting Event:
	e.Cancel = True to cancel the de-selection.
	Putting a Panel in a TabPage to hold all its controls, then setting 
	Panel1.Enabled = False will disable all its child-controls.

'TabPage Control

	Dim newPage As TabPage
	For x = 1 To 4
		newPage = New TabPage   'create new instance
		If x = 1 Then
			newPage.Text = "Repeat - 1"
			newPage.Text = x.ToString
		End If

'TextBox Control

    'creating a new TextBox
    Dim tb As New TextBox
    With tb
        .Name = "txtNew1"
        .Text = "Hi new TextBox"
        .Location = New Point(10, 10)
    End With

	'select all with Ctrl-A, disabling Window's "ding"
	Protected Overrides Function ProcessCmdKey(ByRef msg As Message, keyData As Keys) As Boolean
        If TextBox1.Focused AndAlso keyData = (Keys.A Or Keys.Control) Then
            Return True
        End If
        Return MyBase.ProcessCmdKey(msg, keyData)
    End Function
	'************ USING SuppressKeyPress IS MUCH SIMPLER:
	Private Sub TextBox1_KeyDown(sender As Object, e As KeyEventArgs) Handles TextBox1.KeyDown

        If e.KeyCode = Keys.A AndAlso e.Modifiers = Keys.Control Then
            e.Handled = True
            e.SuppressKeyPress = True
        End If
    End Sub

'ToolTip Control

    ToolTip1.SetToolTip(TextBox1, "Hello textbox 1")
'TreeView populate with files and folders

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim root As TreeNode = TreeView1.Nodes.Add("Documents")
        PopulateTreeView("c:\users\andrew\documents", root)

    End Sub

    Private Sub PopulateTreeView(ByVal dir As String, ByVal parentNode As TreeNode)
        Dim folder As String = String.Empty
			'Add folders to treeview
            Dim folders() As String = IO.Directory.GetDirectories(dir)
            If folders.Length <> 0 Then
                Dim folderNode As TreeNode = Nothing
                Dim folderName As String = String.Empty
                For Each folder In folders
                    folderName = IO.Path.GetFileName(folder)
                    folderNode = parentNode.Nodes.Add(folderName)
                    folderNode.Tag = folder
                    PopulateTreeView(folder, folderNode)
            End If
            'Add the files to treeview
            Dim files() As String = IO.Directory.GetFiles(dir)
            If files.Length <> 0 Then
                Dim fileNode As TreeNode = Nothing
                For Each file As String In files
                    fileNode = parentNode.Nodes.Add(IO.Path.GetFileName(file))
                    fileNode.Tag = file
            End If
        Catch ex As UnauthorizedAccessException
            parentNode.Nodes.Add("Access Denied")
        End Try
    End Sub

'Validating Event

    Private Sub TextBox1_Validating(sender As Object, e As System.ComponentModel.CancelEventArgs) _
            Handles TextBox1.Validating
        Dim tb = DirectCast(sender, TextBox)
        If Not "ABCD".Contains(tb.Text.ToUpper) Then
            MessageBox.Show("Not A,B,C or D.")
            e.Cancel = True
        End If
    End Sub

'WebBrowser Control

    WebBrowser1.Navigate("")    'or
    WebBrowser1.Navigate(New Uri(""))
    'display from text-file (resource) or string
    WebBrowser1.DocumentText = My.Resources.TextFile1
    WebBrowser1.DocumentText = "<html><body><h1>My email</h1></body></html>"
	'clicking a button
    'to follow a hyperlink (an a-link) extract its href attribute 
    'and use WebBrowser.Navigate(href)
	'adding text to an input element
	WebBrowser1.document.GetElementById("the_id").InnerText = "whatever.."

    'search for elements
    Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As _ 
			WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted

        If WebBrowser1.Url.ToString.Contains("bbc") Then
            MessageBox.Show("The BBC!")
        End If
        'looping through all a-links
        Dim addresses As String = ""
        Dim pageElements As HtmlElementCollection = WebBrowser1.document.GetElementsByTagName("A")
        'or WebBrowser1.document.All
        For Each currElement As HtmlElement In pageElements
            addresses &= currElement.GetAttribute("href") & vbNewLine
    End Sub
    'search for element, not knowing id
    Dim elems As HtmlElementCollection
    'if the ID is known:
    'Dim elem As HtmlElement = WebBrowser1.document.GetElementById("someId")

    Dim doc = WebBrowser1.Document
    If doc IsNot Nothing Then
        'the page is available..
        '(use DocumentCompleted event in preference)
    End If
    elems = WebBrowser1.document.GetElementsByTagName("INPUT")
    Dim elem4 As HtmlElement = elems(3)		'the fourth input
	Dim elem As HtmlElement = WebBrowser1.document.All.GetElementsByName("to")(0)
	elem.SetAttribute("value", "Hi there!")
	'combine GetElementsByName with GetELementsByTagName
	Dim elem As HtmlElement = WebBrowser1.document. _
	elem.SetAttribute("value", "Hi there!")

    'remove an element
    Dim pageElements As HtmlElementCollection = WebBrowser1.document.GetElementsByTagName("input")
    For Each currElement As HtmlElement In pageElements
        If currElement.GetAttribute("type").ToLower = "submit" Then
            currElement.OuterHtml = ""
        End If
	'Prevent opening of new window
    Private Sub WebBrowser1_NewWindow(sender As Object, e As System.ComponentModel.CancelEventArgs) _
            Handles WebBrowser1.NewWindow
        e.Cancel = True
	End Sub

	'Prevent pop-up on leaving page (untested)
    Private Sub WebBrowser1_DocumentCompleted(sender As Object, _ 
			e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
        Dim doc As HtmlDocument = WebBrowser1.Document
        Dim head As HtmlElement = doc.GetElementsByTagName("head")(0)
        Dim s As HtmlElement = doc.CreateElement("script")

        s.SetAttribute("text", "function cancelOut() { window.onbeforeunload = null; }")
    End Sub
	'Use WebBrowser to evaluate expression
	Imports System.Security.Permissions

	<PermissionSet(SecurityAction.Demand, Name:="FullTrust")> _
	Public Class Form1
		Dim browser As New WebBrowser

		Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
			browser.ObjectForScripting = Me
			'browser.ScriptErrorsSuppressed = True
			browser.DocumentText = "<script>function evalIt(x) { return eval(x); }</script>"
		End Sub

		Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

			Dim result = browser.document.InvokeScript("evalIt", New String() {"3+4*5"})
			If result IsNot Nothing Then
				MessageBox.Show(result.ToString())     '23
			End If
		End Sub
	End Class


Array.FindIndex - to search an array of objects (using lambda)

	Dim people(9) As Person		'Person is the Class
	people(3).FirstName = "Bob"
	Dim idx = Array.FindIndex(people, Function(p As Person) p.FirstName = "Bob")


	Dim myInt() = {1, 2, 5}
	myInt = Array.ConvertAll(myInt, Function(x) x + 100)
	For Each el In myInt
		Console.Write(el.ToString() & ", ")

Bitwise Enumerations

To change an attribute, use the following:
to set an attribute, use Or
to toggle an attribute, use Xor
to turn off an attribute, use And Not
to leave an attribute on but turn off all others, use And


    Dim strClip As String = Clipboard.GetText()
    Dim strClipArray() = strClip.Split(Environment.NewLine)

    For Each line In strClipArray

'ConnectionString (Access)

    Dim cn As New OleDb.OleDbConnection
    cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & "C:\Users\Andrew\Documents\Staff Database.accdb;Jet OLEDB:Database Password=MyPassword;"

'csv, populate DataTable (allows random access)

	Imports System.Data.OleDb
    Dim sLocation = "C:\Users\Andrew\Documents\"
    Dim sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sLocation & _
        ";Extended Properties=""text;HDR=Yes;FMT=Delimited"";"

    Dim dt As New DataTable("employees")

    Using adapt As New OleDbDataAdapter("SELECT * FROM [Employees.csv]", sConn)
    End Using
	Debug.Print(String.Join(",", dt.Rows(3).ItemArray()))
	'388991633,Katy,Abachiche,7269 Washington Blvd,Burlington,TX,etc..
	For x As Integer = 3 To 10
		Debug.Print("{0} {1}", dt.Rows(x)("FirstName"), dt.Rows(x)("City"))
	Dim cowboys = From duke In dt		'.AsEnumerable() - not necessary
				  Where duke("City") = "Dallas" And duke("Salary") > 40000
				  Order By duke("LastName")

	For Each dude In cowboys
		Debug.Print("{0} {1} {2}", dude("FirstName"), dude("LastName"), dude("Salary"))
	'using a Data Reader instead of Data Adapter
	Dim dt As New DataTable("employees")

	Using conn As New OleDbConnection(sConn)
		Dim cmd As OleDbCommand = New OleDbCommand("SELECT * FROM [Employees.csv]", conn)
		If conn.State <> ConnectionState.Open Then
		End If
		Dim reader As OleDbDataReader = cmd.ExecuteReader(Commandbehavior.CloseConnection)

		Debug.Print("There are {0} rows.", dt.Rows.Count)
		'There are 2320 rows.
	End Using

'DataSource (DataGridView)

    'Filter rows (not tested yet)
    Dim dt As New DataTable()
    dt = TryCast(DataGridView1.DataSource, DataTable)
    If dt IsNot Nothing Then
        dt.DefaultView.RowFilter = String.Format("Field_Name = '{0}'", Trim(TextBox1.Text))
    End If
	'to clear the filter:
	DefaultView.RowFilter = String.Empty

'DataTable, ColumnChanged
    Private _dt As DataTable = New DataTable("tblTest")
    Private _changed As Boolean = False

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        _dt.Columns.Add("Name", Type.GetType("System.String"))
        _dt.Columns.Add("Number1", Type.GetType("System.Int32"))
        _dt.Columns.Add("Number2", Type.GetType("System.Int32"))

        Dim row As DataRow = _dt.NewRow()
        row("Name") = "Bob"
        row("Number1") = 5
        row("Number2") = 20

        Me.txtName.DataBindings.Add("Text", _dt, "Name", False, DataSourceUpdateMode.onpropertychanged)
        Me.nupFirst.DataBindings.Add("Value", _dt, "Number1", False, DataSourceUpdateMode.onpropertychanged)
        Me.nupSecond.DataBindings.Add("Value", _dt, "Number2", False, DataSourceUpdateMode.onpropertychanged)

        AddHandler _dt.ColumnChanged, AddressOf Column_Changed
    End Sub

    Private Sub Column_Changed(sender As Object, e As DataColumnChangeEventArgs)
        If Not _changed Then
            _changed = True
            MessageBox.Show("Something has changed..")
            RemoveHandler _dt.ColumnChanged, AddressOf Column_Changed
        End If
    End Sub


    Dim time As DateTime = DateTime.Parse("00:00:00.1334274")
    Console.Write(time.Millisecond.ToString)     '133




    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Dim mail As New MailMessage
        mail.To.Add("[email protected]")
        mail.From = New MailAddress("[email protected]")
        mail.Subject = "Just a test"
        mail.Body = "Hi there Andy!"

        Dim smtp As New SmtpClient("", 587) With {.Credentials =
            New NetworkCredential("[email protected]", "Password1"), .EnableSsl = True}

    End Sub


	'Create alphabet
	Dim letts() As Char = Enumerable.Range(1, 26).
		Select(Function(x) Chr(x + 64)).ToArray

	For Each lett In letts

'Father/Son Update

    Dim sr As New StreamReader(filename)
    Dim sw As New StreamWriter(Path.ChangeExtension(filename, "tmp"))
    Dim buffer As String = sr.ReadLine()
    While buffer IsNot Nothing
        sw.WriteLine(buffer.Replace("foo", "bar"))
        buffer = sr.ReadLine()
    End While
    File.Copy(Path.ChangeExtension(filename, "tmp"), filename, True)
    File.Delete(Path.ChangeExtension(filename, "tmp"))

'Files, get total size based on extensions

	Dim info As DirectoryInfo = New DirectoryInfo("c:\users\andrew\documents")
	Dim search() As String = {".xlsx", ".docx"}

	'Dim totalSize As Double = Aggregate file In info.EnumerateFiles("*.*")
	'                Where search.Contains(file.Extension.ToLower())
	'                Into Sum(file.Length)

	'Dim totalSize As Double = Aggregate file In info.EnumerateFiles("*.*").Where(
	'						  Function(x) search.Contains(x.Extension.ToLower()))
	'				Into Sum(file.Length)
	Dim totalSize As Double = info.EnumerateFiles("*.*").Where(
			Function(x) search.Contains(x.Extension.ToLower())).Sum(Function(y) y.Length)

	Console.WriteLine("{0:N0} Bytes", {totalSize})
	Console.WriteLine("{0:N2} KB", {totalSize / 1024})
	Console.WriteLine("{0:N2} MB", {totalSize / (1024 * 1024)})

'Files, get all files and subfolders (and their files)
Imports System.IO

Public Class Form1

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    End Sub

    Private Sub ListFilesAndFolders(location As String)
            For Each sFile In Directory.GetFiles(location)
        Catch ex As UnauthorizedAccessException
            Debug.Print("Unauthorized file access")
        Catch ex As Exception
        End Try
        For Each sPath In Directory.GetDirectories(location)
            Catch ex As Exception
                'ignore, only iterating
            End Try

    End Sub
End Class


	'Copy file with sequence number if Exists
    Imports System.IO

	Dim sOld As String = "C:\Users\Andrew\Documents\SampleText.txt"
	Dim sNew As String = "C:\Users\Andrew\Documents\ATextFile.txt"

	Dim sNewDir As String = Path.GetDirectoryName(sNew) & Path.DirectorySeparatorChar
	Dim sNewFile As String = Path.GetFileNameWithoutExtension(sNew)
	Dim sNewExtn As String = Path.GetExtension(sNew)
	Dim x As Integer = 0

	If File.Exists(sNew) Then
			x = x + 1
			sNew = sNewDir & sNewFile & CStr(x) & sNewExtn
		Loop While File.Exists(sNew)
	End If
	File.Copy(sOld, sNew)

'GetFiles of different extensions

	For Each f As String In Directory. _
		GetFiles("C:\users\andrew\documents\", "*.*").Where(Function(x)
														Dim y = System.IO.Path.GetExtension(x)
														'Return (y = ".txt" OrElse y = ".xlsx")
														Return (New String() {".doc", ".txt"}).
													End Function)

'Folders, list subfolders with exclusions

    Dim excludes() As String = {"Visual", "Aptana"}


    Private Sub GetDirs(path As String)
        For Each dr In Directory.EnumerateDirectories(path)
            Dim excludeIt As Boolean = False
            For Each excl As String In excludes
                If dr.Contains(excl) Then
                    excludeIt = True
                    Exit For
                End If
            If Not excludeIt Then
            End If
    End Sub

'Handling Null

	Dim cmd As New SqlCommand
	cmd.Parameters.Add("cost", SqlDbType.Int)
	cmd.Parameters("cost").IsNullable = True
	cmd.Parameters("cost").Value = IIf(String.IsNullOrEmpty(TextBox1.Text), _ 
			DBNull.Value, CInt(TextBox1.Text))


    Dim img As New System.Drawing.Icon("path to file")
    Me.Icon = img

'LINQ Examples

    Dim str4 = "Hi there    and    hello again    end."
    Dim str5 = String.Join(" ", From s In str4.Split(" ") Select s Where s.Trim(" ").Length > 0)

	Dim letts As New Dictionary(Of Char, Integer)
	For x = 0 To 25
		letts(Chr(65 + x)) = Int(Rnd() * 15)
	Dim top10 = (From x In letts
				 Order By x.Value Descending
				 Select x.Key, x.Value).Take(10)
	For Each x In top10
		Debug.Print(x.Key & " " & x.Value)

	'check string for 3 letters followed by 2 numbers
    Dim test As String = "abc12"
    Dim passed As Boolean = test.Length = 5

    If passed Then
        passed = test.ToCharArray().Where(Function(x, ind)
                                        Return If(ind < 3, Char.IsLetter(x), Char.IsNumber(x))
                                    End Function).Count() = 5
    End If

'LINQ Group By and Sum *********************
Module Module1
'requires a textfile with 4 comma-separated columns
    Sub Main()
        Dim allEmployees = From line In System.IO.File.ReadLines("C:\users\andrew\documents\test.txt")
                           Let Columns = line.Split(","c)
                           Where Columns.Length = 4
                           Let empNum = Integer.Parse(Columns(0).Trim())
                           Let eCode = Columns(1)
                           Let webCode = Columns(2)
                           Let hrsWrk = Decimal.Parse(Columns(3))
                           Select New Employee With {.empNo = empNum, .eCode = eCode, .webCode = webCode, .hrsWork = hrsWrk}

        Dim EmpList As List(Of Employee) = allEmployees.ToList()

        Dim summary = From emp In EmpList
                      Group emp By Key = New With {Key emp.empNo, Key emp.eCode, Key emp.webCode}
                      Into Group
                      Select New With {.num = Key.empNo, .code = Key.eCode, _
                                       .web = Key.webCode, .total = Group.Sum(Function(x) x.hrsWork)}

        For Each item In summary
            Console.WriteLine("{0} {1} {2} {3}", item.num, item.code, item.web,

    End Sub

    Public Class Employee
        Public Property empNo As Integer
        Public Property eCode As String
        Public Property webCode As String
        Public Property hrsWork As Decimal
    End Class

End Module
or .....
        Dim summary = From emp In EmpList
                      Group emp By Key = New With {Key emp.empNo, Key emp.eCode, Key emp.webCode}
                      Into g = Group, s = Sum(emp.hrsWork)
                      Select New With {.num = Key.empNo, .code = Key.eCode, _
                                       .web = Key.webCode, .total = s}        'Group.Sum(Function(x) x.hrsWork)}


    Dim objMOS As ManagementObjectSearcher
    Dim objMOC As Management.ManagementObjectCollection
    Dim objMO As Management.ManagementObject

    objMOS = New ManagementObjectSearcher("Select * From Win32_OperatingSystem")
    objMOC = objMOS.Get
    For Each objMO In objMOC
    objMOS = Nothing
    objMO = Nothing

'Path (System.IO)

    Dim chPath As Char = System.IO.Path.DirectorySeparatorChar
    Debug.Print(System.IO.Path.GetFileName("C:\users\blah.txt"))    'blah.txt
    Debug.Print(System.IO.Path.GetFileNameWithoutExtension("C:\users\blah.txt"))    'blah
    Debug.Print(System.IO.Path.GetFullPath("C:\users\blah.txt"))    'C:\users\blah.txt

'Regex Examples

    Dim str2 As String = "Hi there    and    hello again    end."
    Dim r2 As New Regex("\s+")
    Dim str3 = r2.Replace(str2, " ", 1)

    Private Function FormatPhoneNumber(ByVal number As String) As String
        If number.Length <> 10 Then
            Return String.Empty     'not 10 characters
        End If
        Dim value As Long
        If Not Long.TryParse(number, value) Then
            Return String.Empty     'not all digits
        End If

        Dim pattern As String = "(\d{3})(\d{3})(\d{4})"
        Dim replacement As String = "($1) $2-$3"
        Dim formatted As String = New Regex(pattern).Replace(number, replacement)
        Return formatted
    End Function

	'multiply numbers (by 2)
	Dim orig As String = "10 cup mayo, 2 tablespoons basil, and 3 cups ranch dressing"
	Dim pattern As String = "\b(\d)+\b"
	Dim evaluator As MatchEvaluator = AddressOf DoubleUp

	Dim result As String = Regex.Replace(orig, pattern, Function(x As Match) CStr(CInt(x.Value) * 2))
	'or .Replace(orig, pattern, evaluator)
	'"20 cup mayo, 4 tablespoons basil, and 6 cups ranch dressing"
	Private Function DoubleUp(match As Match) As String
        Return CStr(CInt(match.Value) * 2)
    End Function

'Releasing COM Objects
    'from CharlieMay @ DIC, 
    Private Sub ReleaseObject(ByVal obj As Object)
            obj = Nothing
        Catch ex As Exception
            obj = Nothing
        End Try
    End Sub

'Populating DataGridView from Excel data
Imports Excel = Microsoft.Office.Interop.Excel  'Add Reference
'Microsoft Excel 14.0 Object Library

Public Class frmExcel

    Private Sub btnNameRange_Click(sender As Object, e As EventArgs) Handles btnNameRange.Click
        Dim xlApp As New Excel.Application
        Dim xlBook As Excel.Workbook = xlApp.Workbooks.Open("C:\Users\Andrew\Documents\AndysData.xlsx")
        Dim xlSheet As Excel.Worksheet = xlBook.Worksheets(1)	'or use worksheet-name
        xlSheet.Range("A5").CurrentRegion.Name = "staffData"
        xlBook.Close(True)      'save changes

    End Sub

    Private Sub btnFillExcel_Click(sender As Object, e As EventArgs) Handles btnFillExcel.Click
        Dim sConn As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Andrew\Documents\AndysData.xlsx;"
        sConn &= "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
        Using conn As New OleDb.OleDbConnection(sConn)
            Dim dSet As New DataSet

            Dim adapt As New OleDb.OleDbDataAdapter("SELECT * FROM [staffData]", conn)
            adapt.Fill(dSet, "tblStaff")
            dgvExcel.DataSource = dSet.Tables("tblStaff")
        End Using
    End Sub

    Private Sub ReleaseObject(ByVal obj As Object)
            obj = Nothing
        Catch ex As Exception
            obj = Nothing
        End Try
    End Sub
End Class

'Settings (My)

    'Assume sCol is already created in the Project Properties as a StringCollection
    My.Settings.sCol.Clear()  'clear everything
    'add the following to the FormClosed event:

'SQL Parameters

	Private Sub btnGo_Click(sender As Object, e As EventArgs) Handles btnGo.Click
		Dim sConn As String = "Data Source=.\SQLExpress;Initial Catalog=northwind;Integrated Security=True"

		Dim sSql As String = "SELECT * FROM Orders WHERE ShipCountry = @Country AND OrderDate > @OrderDate"

		Dim conn As New SqlConnection(sConn)
		Dim cmd As New SqlCommand(sSql, conn)

		'could configure parameters individually:
		cmd.Parameters.Add("@Country", SqlDbType.NVarChar)
		cmd.Parameters("@Country").Value = txtCountry.Text

		'easier to add in one go, and let the database deal with the data-type:
		cmd.Parameters.AddWithValue("@OrderDate", dtpOrderDate.Value)

		Dim adapter As New SqlDataAdapter(cmd)
		Dim ds As New DataSet()
		adapter.Fill(ds, "OrdersTable")

		dgvData.DataSource = ds
		dgvData.DataMember = "OrdersTable"
	End Sub


    Structure Country
        Dim Name As String
        Dim Abbreviation As String
    End Structure

    Dim Countries() As Country = {New Country With {.Name = "France", .Abbreviation = "FR"}} 'etc..

    Dim sCountry As String = "France"   'get this text from TextBox.Text

    For Each item As Country In Countries
        If sCountry = item.Name Then
            'found France in Array!
        End If




		'Find hours difference
        Dim current As DateTime = DateTime.Now
        Dim prev As DateTime = DateTime.Parse("April 19, 2014")

        Dim diff As TimeSpan = current.Subtract(prev)

        Console.WriteLine("Diff in hours: {0}", diff.TotalHours)

'Work Days Function

    Public Function AddWorkDays(ByVal dte As Date, ByVal x As Integer) As Date
        Dim a As Integer = If(x < 0, -1, 1)
        Dim weekend = {DayOfWeek.Saturday, DayOfWeek.Sunday}
        While x <> 0 Or weekend.Contains(dte.DayOfWeek)
            dte = dte.AddDays(a)
            x -= If(x = 0 Or weekend.Contains(dte.DayOfWeek), 0, a)
        End While
        Return dte
    End Function

'Data Source (simple - drag of details)

	Public Class Form1
		Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
			'TODO: This line of code loads data into the 'SQLTrainingDataSet.customers' table. 
			'You can move, or remove it, as needed.
		End Sub

		Private Sub btnNext_Click(sender As Object, e As EventArgs) Handles btnNext.Click
		End Sub

		Private Sub btnPrev_Click(sender As Object, e As EventArgs) Handles btnPrev.Click
		End Sub

		Private Sub btnUpdate_Click(sender As Object, e As EventArgs) Handles btnUpdate.Click
		End Sub
	End Class

'Day of week - get following Monday
	For x As Integer = 0 To 30
		Dim day = DateTime.Now.AddDays(x)
		dim mon = day.AddDays((7 - day.DayOfWeek + 1) Mod 7)
		If day.DayOfWeek = DayOfWeek.Monday Then mon = mon.AddDays(7)
		Debug.Print(day & " " & mon)
	Next x

'Check if connected to internet (tested from VBA)

	Private Declare Function InternetGetConnectedState Lib "wininet.dll" ( _ 
			ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long

	Private Sub TestConn()
		Dim bConnected As Boolean

		bConnected = InternetGetConnectedState(0, 0)
		If bConnected Then
			MsgBox "Whe'hay, connected!"
			MsgBox "Doi, no connection!"
		End If
	End Sub

'XML as XDocument

    Sub Main()
        Dim theXml = <?xml version="1.0" encoding="utf-8"?>
                             <Item Name="Widget">
                             <Item Name="Sprocket">

        'to create an XDocument from a file..
        'Dim theXml2 As New XDocument()
        'theXml2 = Xdocument.Load("somefile.xml")

        For Each Item In theXml.Descendants("Item")
            For Each subItem In Item.Elements("Sub-Item")

        'prints Widget, Yellow, Orange, Sprocket, Red, Blue, Green
    End Sub

'Check string for just digits
	Dim test As String = "1444"
	Dim outTest As UInteger
	If Not test.StartsWith("+") AndAlso UInteger.TryParse(test, outTest) Then
		MessageBox.Show("It's just digits!")
	End If

1 Comments On This Entry

Page 1 of 1

andrewsw Icon

14 May 2016 - 05:39 AM
Here's a Dropbox link to the file.
Page 1 of 1

Trackbacks for this entry [ Trackback URL ]

There are no Trackbacks for this entry

October 2017

1516171819 20 21


    Recent Entries

    Recent Comments

    Search My Blog

    1 user(s) viewing

    1 Guests
    0 member(s)
    0 anonymous member(s)