Use Full Functions

[sukeshchand]

Friends here i am posting some function thats usefull for visual basic programmers. If you have some please Post.

'Get A Value From Database
Public Function GetField(ByRef conn As ADODB.Connection, ByVal StrSql As String) As Variant
On Error GoTo ErrHr
With conn.Execute(StrSql)
    If Not .EOF Then
        GetField = .Fields(0) & ""
    End If
    .Close
End With
Exit Function
Set conn = Nothing
ErrHr:
MsgBox Err.Description
End Function

[sukeshchand]

'Function to check the control is present in the array or not

Private Function ChkCtrl(ByVal CtrlName As String, ByRef Ctrls() As Variant) As Boolean
Dim i As Integer
ChkCtrl = False
CtrlName = UCase(CtrlName)
For i = LBound(Ctrls) To UBound(Ctrls)
    If UCase(Ctrls(i)) = CtrlName Then
        ChkCtrl = True
        Exit Function
    End If
Next i
End Function

[sukeshchand]

Function to Clear Controls inside a group box(like Picbox,frame etc) or inside a form

Public Function ClearObjControls(ByVal obj As Object, ParamArray AvoidCtrls() As Variant)
On Error Resume Next   '--Skip to next statement if any error occur
Dim i As Integer
Dim CtrlArray() As Variant
ReDim CtrlArray(UBound(AvoidCtrls) + 1)
For i = LBound(AvoidCtrls) To UBound(AvoidCtrls)
    CtrlArray(i) = AvoidCtrls(i).Name
Next i
Dim mc As Control

If TypeOf obj Is Form Then
    For Each mc In obj.Controls
        If Not ChkCtrl(mc.Name, CtrlArray) Then
            If TypeName(mc) = "TextBox" Then
                mc.Text = ""
            ElseIf TypeName(mc) = "ComboBox" Then
                mc.Text = ""
            ElseIf TypeName(mc) = "CheckBox" Then
                mc.Value = 0
            End If
        End If
    Next
Else
    For Each mc In obj.Parent.Controls
        If Not ChkCtrl(mc.Name, CtrlArray) And UCase(obj.Name) = UCase(mc.Container.Name) Then
            If TypeName(mc) = "TextBox" Then
                mc.Text = ""
            ElseIf TypeName(mc) = "ComboBox" Then
                mc.Text = ""
            ElseIf TypeName(mc) = "CheckBox" Then
                mc.Value = 0
            End If
        End If
    Next
End If
End Function

[sukeshchand]

Clear Particular Type of control in an object(Like Frame, PicBox or Form)

Public Enum SControls
    s_TextBox = 1
    s_ComboBox = 2
    s_CheckBox = 3
    s_OptionButton = 4
    s_Label = 5
    s_ListBox = 6
End Enum
Public Function ClearGroupControls(ByVal obj As Object, ByVal Ctrl As SControls, ParamArray AvoidCtrls() As Variant)
On Error Resume Next   '--Skip to next statement if any error occur
Dim i As Integer
Dim CtrlArray() As Variant
ReDim CtrlArray(UBound(AvoidCtrls) + 1)
For i = LBound(AvoidCtrls) To UBound(AvoidCtrls)
    CtrlArray(i) = AvoidCtrls(i).Name
Next i
Dim mc As Control

If TypeOf obj Is Form Then
    For Each mc In obj.Controls
        If Not ChkCtrl(mc.Name, CtrlArray) Then
            If Ctrl = s_CheckBox Then
                If TypeName(mc) = "CheckBox" Then
                    mc.Value = 0
                End If
            ElseIf Ctrl = s_ComboBox Then
                If TypeName(mc) = "ComboBox" Then
                    mc.Text = ""
                End If
            ElseIf Ctrl = s_Label Then
                If TypeName(mc) = "Label" Then
                    mc.Caption = ""
                End If
            ElseIf Ctrl = s_ListBox Then
                If TypeName(mc) = "ListBox" Then
                    mc.Clear
                End If
            ElseIf Ctrl = s_OptionButton Then
                If TypeName(mc) = "OptionButton" Then
                    mc.Value = False
                End If
            ElseIf Ctrl = s_TextBox Then
                If TypeName(mc) = "TextBox" Then
                    mc.Text = ""
                End If
            End If
        End If
    Next
Else
    For Each mc In obj.Parent.Controls
        Debug.Print mc.Name & "    " & mc.Parent.Name
        If Not ChkCtrl(mc.Name, CtrlArray) And UCase(mc.Container.Name) = UCase(obj.Name) Then
            If Ctrl = s_CheckBox Then
                If TypeName(mc) = "CheckBox" Then
                    mc.Value = 0
                End If
            ElseIf Ctrl = s_ComboBox Then
                If TypeName(mc) = "ComboBox" Then
                    mc.Text = ""
                End If
            ElseIf Ctrl = s_Label Then
                If TypeName(mc) = "Label" Then
                    mc.Caption = ""
                End If
            ElseIf Ctrl = s_ListBox Then
                If TypeName(mc) = "ListBox" Then
                    mc.Clear
                End If
            ElseIf Ctrl = s_OptionButton Then
                If TypeName(mc) = "OptionButton" Then
                    mc.Value = False
                End If
            ElseIf Ctrl = s_TextBox Then
                If TypeName(mc) = "TextBox" Then
                    mc.Text = ""
                End If
            End If
        End If
    Next
End If
End Function

[sukeshchand]

Clear individual controls in the form

Public Function ClearControls(ParamArray Ctrls() As Variant)
On Error Resume Next
Dim i As Integer
For i = LBound(Ctrls) To UBound(Ctrls)
    If TypeName(Ctrls(i)) = "TextBox" Then
        Ctrls(i).Text = ""
    ElseIf TypeName(Ctrls(i)) = "ComboBox" Then
        Ctrls(i).Text = ""
    ElseIf TypeName(Ctrls(i)) = "CheckBox" Then
        Ctrls(i).Value = 0
    ElseIf TypeName(Ctrls(i)) = "Label" Then
        Ctrls(i).Caption = ""
    ElseIf TypeName(Ctrls(i)) = "OptionButton" Then
        Ctrls(i).Value = False
    ElseIf TypeName(Ctrls(i)) = "ListBox" Then
        Ctrls(i).Clear
    End If
Next i
End Function

[sukeshchand]

Bind Database Fields to Given Variables

Public Function BindFields(ByVal conn As ADODB.Connection, ByVal StrSql As String, ParamArray Varbls() As Variant) As Boolean
On Error GoTo ErrHr

Dim i As Integer
Dim MaxVNo As Integer
MaxVNo = UBound(Varbls)

With conn.Execute(StrSql)
    For i = 0 To .Fields.Count - 1
        If i < MaxVNo + 1 Then
            Varbls(i) = .Fields(i)
        End If
    Next i
End With

Exit Function
ErrHr:

End Function

[sukeshchand]

This function returns the string in specified allignment

Public Enum Allignment
    s_AllignRight = 0
    s_AllignLeft = 1
    s_AllignCentre = 2
    s_Default = 3
End Enum

Public Function AllignString(ByVal St As Variant, Optional Length As Integer = 0, Optional Allin As Allignment = s_Default)
On Error GoTo ErrHr
Dim L As Integer
Dim T As Integer
Dim LR As Integer 'Length Remaning
L = Len(St)
LR = Length - L
If LR > 0 Then
    If Allin = s_AllignLeft Then
        AllignString = St & Space(LR)
    ElseIf Allin = s_AllignRight Then
        AllignString = Space(LR) & St
    ElseIf Allin = s_AllignCentre Then
        T = Int(LR / 2)
        AllignString = Space(T) & St & Space(T)
    ElseIf Allin = s_Default Then
        If IsNumeric(St) Then
            AllignString = AllignString(St, Length, s_AllignRight)
        ElseIf IsDate(St) Then
            AllignString = AllignString(St, Length, s_AllignCentre)
        Else
            AllignString = AllignString(St, Length, s_AllignLeft)
        End If
    End If
Else
    AllignString = St
End If

Exit Function
ErrHr:
End Function

[sukeshchand]

Function for checking null values

Public Enum iDataType
    s_Text = 0
    s_Number = 1
    s_Date = 2
    s_Time = 3
End Enum

Public Function sCheck(Optional ByVal Data As Variant = "", Optional ByVal DataType As iDataType) As Variant
If DataType = s_Text Then
    If Data = "" Then
        sCheck = ""
    Else
        sCheck = Trim(CStr(Data))
    End If
ElseIf DataType = s_Number Then
    If IsNumeric(Data) Then
        sCheck = Val(Data)
    Else
        sCheck = 0
    End If
ElseIf DataType = s_Date Then
    If IsDate(Data) Then
        sCheck = Data
    Else
        sCheck = Date
    End If
ElseIf DataType = s_Time Then
    If IsDate(Data) Then
        sCheck = Data
    Else
        sCheck = Time
    End If
End If
End Function