Functions

  
  '############################################################
      Public Sub FillDataList(ByRef objList As Object, ByVal strSQL As String)
        Dim con As New OleDb.OleDbConnection
        con.ConnectionString = dbprovider & dbsource
        con.Open()
        Dim ds As New DataSet
        Dim da As OleDb.OleDbDataAdapter
        Dim sql As String
        sql = strSQL
        da = New OleDb.OleDbDataAdapter(sql, con)
        da.Fill(ds, "MyData")
        Dim MaxRecCount As Integer
        Dim inc As Integer
        inc = -1
        MaxRecCount = ds.Tables("MyData").Rows.Count
        For inc = 0 To MaxRecCount - 1
            objList.Items.Add(ds.Tables("MyData").Rows(inc).Item(0))
        Next inc
        con.Close()
      End Sub
  '############################################################

Fill ComboBox With SQL Generated Data

Capture Drag Drop Object Information

  
  '##########################################################
  
  Imports System.Runtime 'Allow App To Execute Other Apps
  Imports System.IO 'Allow Access To Files
    
    Private MyFile As FileInfo
  
    Private Sub Button1_DragEnter(sender As Object, e As System.Windows.Forms.DragEventArgs) Handles Button1.DragEnter
        'Display Behaviour of Mouse For File Drag
        If e.Data.GetDataPresent(DataFormats.FileDrop) Then
            e.Effect = DragDropEffects.Copy
        End If
    End Sub

    Private Sub Button1_DragDrop(sender As Object, e As System.Windows.Forms.DragEventArgs) Handles Button1.DragDrop

        'Get (Single) File Path From DRopped File
        Dim file As String = e.Data.GetData(DataFormats.FileDrop)(0)

        'Load File Information Into FileInfo Object
        MyFile = New FileInfo(file)

        'Abort If Not A Valid File...(By Checking For A File Extension)
        If String.IsNullOrWhiteSpace(MyFile.Extension) Then Exit Sub

        'Open Show Info Sub
        ShowFileInfo()

    End Sub


    Private Sub ShowFileInfo()

        'Display File Attributes Taken From MyFile Object
        TextBox1.Text = MyFile.FullName
        txtFileName.Text = MyFile.Name
        txtFileType.Text = MyFile.Extension
        txtFileSize.Text = Math.Round(MyFile.Length / 1024) & "KB"
        txtCreated.Text = MyFile.CreationTime
        txtModified.Text = MyFile.LastWriteTime
        pbIcon.Image = Icon.ExtractAssociatedIcon(MyFile.FullName).ToBitmap

    End Sub

Calculate DataGrid Totals

  
  '############################################################
    Public Function GetGridTotal(objGrid As Object, intcol As Integer) As Double
        On Error GoTo Err_Fail
        Dim X As Integer
        GetGridTotal = 0
        Dim currValue As Double
        'Loop Through Datagrid
        For X = 0 To objGrid.RowCount - 1
            'Protect From NULL Values In Grid
            If (objGrid.Rows(X).Cells(intcol).value) IsNot DBNull.Value Then
                currValue = Val(WithCurrencySign(Trim(objGrid.Rows(X).Cells(intcol).Value), False))
                If currValue <> 0 Then
                    GetGridTotal = GetGridTotal + currValue
                End If
            End If
        Next X
        Exit Function
    Err_Fail:
        GetGridTotal = 0
        MsgBox(ErrorToString)
    End Function
  '############################################################

Create A New Incremented ID Number

  
  '############################################################
    Public Function CreateNewSessionID() As Integer
        On Error GoTo Err_Fail
        'Open Database
        dbprovider = "PROVIDER=Microsoft.jet.OLEDB.4.0;"
        dbsource = "Data Source =" & System.AppDomain.CurrentDomain.BaseDirectory() & "/Training2020.mdb"
        con.ConnectionString = dbprovider & dbsource
        con.Open()
        'Select Highest Current Session ID
        Dim ds As New DataSet
        Dim da As OleDb.OleDbDataAdapter
        Dim sql As String
        sql = "SELECT top 1 sessionID from tblSessionLog order by sessionID desc"
        da = New OleDb.OleDbDataAdapter(sql, con)
        ' Check For No Records
        da.Fill(ds, "SessionID")
        If ds.Tables("SessionID").Rows.Count = 0 Then
            CreateNewSessionID = 1
        Else
            'Increment highest ID And Return It
            CreateNewSessionID = ds.Tables("SessionID").Rows(0).Item("sessionID") + 1
        End If
        con.Close()
        Exit Function
    Err_Fail:
        MsgBox("Error Creating New Session ID. (This Is A Critical Error)", MsgBoxStyle.Critical)
    End Function
  '############################################################

Read Value From Text File

  
  '############################################################
  
  	Imports System.IO 'Allow Access To Files
  

    Private Function GetTextFileData(strSearchString As String, strFilePath As String) As String
        On Error GoTo Err_Fail

        'Check File Exists...
        If System.IO.File.Exists(strFilePath) = False Then
            GetTextFileData = "File Not Found"
            Exit Function
        End If

        'Create File Reader Object
        Dim fileReader As System.IO.StreamReader
        fileReader = My.Computer.FileSystem.OpenTextFileReader(strFilePath, System.Text.Encoding.Default)

        'Set Return Value For Nothing Found
        GetTextFileData = "na"

        'Get First Line
        Dim strLine As String
        strLine = fileReader.ReadLine()

        'Loop Through Text File...
        Do While (Not strLine Is Nothing)
            'Check Each Line For Required String...
            If InStr(strLine, strSearchString) > 0 Then
                'Return Text Line...(With Search String Removed)
                Dim intPos As Integer = Len(strSearchString)
                GetTextFileData = Mid(strLine, intPos + 1)
                fileReader.Close()
                Exit Function
            End If
            strLine = fileReader.ReadLine()
        Loop

        'Free Resource
        fileReader.Close()

        Exit Function
Err_Fail:
        GetTextFileData = "Read Error"
        MsgBox(ErrorToString)
        fileReader.Close()
    End Function
    
  '############################################################

  
  '############################################################
  
  	Imports System.IO 'Allow Access To Files
  
  
    Private Function AmmendTextFileValue(strSearchString As String, strNewValue As String, strFilePath As String) As Boolean
        On Error GoTo Err_Fail

        'Set Return Value For Failed To Ammend
        AmmendTextFileValue = False

        'Check File Exists...
        If System.IO.File.Exists(strFilePath) = False Then Exit Function

        'Create File Reader Object
        Dim fileReader As System.IO.StreamReader
        fileReader = My.Computer.FileSystem.OpenTextFileReader(strFilePath, System.Text.Encoding.Default)

        'Load Text File Into Array...
        Dim FileArray() As String = IO.File.ReadAllLines(strFilePath)
        fileReader.Close()

        'Find Search String & Modify Line With New Value
        Dim X As Integer
        For X = 0 To FileArray.Length - 1
            If InStr(FileArray(X), strSearchString) > 0 Then
                FileArray(X) = strSearchString & " " & strNewValue
                AmmendTextFileValue = True
                Exit For
            End If
        Next

        'ReWrite Array Back To File
        My.Computer.FileSystem.WriteAllText(strFilePath, "", False)
        'Now Use StreamWriter To Rebuild Each Line
        Dim file As System.IO.StreamWriter
        file = My.Computer.FileSystem.OpenTextFileWriter(strINIFilePath, True)
        For Each line In FileArray
            file.WriteLine(line)
        Next
        file.Close()

        Exit Function
Err_Fail:
        AmmendTextFileValue = False
        MsgBox(ErrorToString)
        fileReader.Close()
    End Function

    
  '############################################################

Amend A Text File

  
  '############################################################
  
       Protected Overrides Function ProcessCmdKey(ByRef msg As System.Windows.Forms.Message, ByVal keyData As System.Windows.Forms.Keys) As Boolean
        If msg.WParam.ToInt32() = CInt(Keys.Enter) Then
        
            'SendKeys.Send("{Tab}") ' Acts As TAB Function...
            
            'Redirect To Click Button Event
            Call Me.btnCheck.PerformClick()
            
            Return True
        End If
        Return MyBase.ProcessCmdKey(msg, keyData)
    End Function

    
  '############################################################

Redirect Return Key Event On Form

  
  '############################################################
  
        'Send Speech To Multithread Process
        strMTSpeechText = "Opening " & sender.text.ToString
        Dim thread As System.Threading.Thread
        thread = New System.Threading.Thread(AddressOf MultiThreadSpeech)
        thread.Start()
  
  
    Public Function MultiThreadSpeech() As Boolean
        On Error GoTo Err_Fail
        Dim SAPI
        SAPI = CreateObject("SAPI.spvoice")
        SAPI.Speak(strMTSpeechText)
        MultiThreadSpeech = True
        Exit Function
		Err_Fail:
        		MultiThreadSpeech = False
    End Function

    
  '############################################################

Multithreaded Text To Speech

  
  '############################################################
  
    Public Function CalculateAge(ByVal dteDate As Date) As Integer
        On Error GoTo Err_Fail

        Dim CurrentDate As Date = Date.Now
        Dim TimeAge As TimeSpan = CurrentDate - dteDate
        CalculateAge = (Math.Round((TimeAge.Days / 365), 0))
        Exit Function

Err_Fail:
        CalculateAge = 0
    End Function

    
  '############################################################

Calculate Your Age

www.CarlsPlace.co.uk