Get xml Data and use for insert in vb 6.0

Dim xDoc As MSXML2.DOMDocument
Set xDoc = New MSXML2.DOMDocument
Dim strData As String

If xDoc.Load("C:\test.xml") Then
' The document loaded successfully.
' Now do something intersting.
strData = xDoc.xml
MsgBox strData

' Now strData can be used anywhere to insert data in Database
' or to manupulate the xml data
Else
' The document failed to load.
End If
Set xDoc = Nothing

Read more!

Some Validations Required In VB

' To allow user to check if the text field is blank show red if it is blank and prompt to Enter

Public Function isblank(ByVal txtbox As TextBox) As Boolean
On Err GoTo Err:


If txtbox.Text = "" Or IsNull(txtbox) Then

txtbox.SetFocus
txtbox.BackColor = &HC0C0FF 'red
isblank = True
Else
txtbox.BackColor = vbWhite
End If
Exit Function
Err:
MsgBox Err.Description
isblank = False
End Function


' To allow user to insert only character in the text field

Public Function ValidateString(strInputString As String)
'Can enter a to z A to Z 0 to 9 and _ only
'97 a 122 z 65A 90Z 48 0 57 9 95 _ codes

Dim iCount As Byte
Dim iAsc As Byte

For iCount = 1 To Len(strInputString)
iAsc = Asc(Mid(strInputString, iCount, 1))
If iAsc >= 97 And iAsc <= 122 Then

ElseIf iAsc >= 65 And iAsc <= 90 Then

ElseIf iAsc >= 48 And iAsc <= 57 Then

ElseIf iAsc = 95 Then

Else
ValidateString = False
Exit Function
End If
Next iCount
ValidateString = True
End Function

' To allow user to validate password entry field

Public Function OnlyValidPass(KeyAscii As Integer) As Integer
If Not (KeyAscii >= 65 And KeyAscii <= 90) And Not (KeyAscii >= 97 And KeyAscii <= 122) And Not (KeyAscii >= 48 And KeyAscii <= 57) And Not (KeyAscii = 13 Or KeyAscii = 8) And Not KeyAscii = 32 And Not KeyAscii = 9 And Not KeyAscii = 46 Then
KeyAscii = 0
Beep
MsgBox "Not a valid char"
End If
OnlyValidPass = KeyAscii

End Function

' To allow user to insert only Numbers and Dots in the text field

Public Function OnlyNumericNDot(KeyAscii As Integer) As Integer
If Not (KeyAscii >= 48 And KeyAscii <= 57) And Not (KeyAscii = 13 Or KeyAscii = 8) And Not (KeyAscii >= 1 And KeyAscii <= 26) And Not KeyAscii = 46 Then
KeyAscii = 0
Beep
MsgBox "Only numbers are allowed", vbInformation, "Data Entry Error"
End If
OnlyNumericNDot = KeyAscii
End Function

' To allow user to insert only Numbers in the text field

Public Function OnlyNumeric(KeyAscii As Integer) As Integer
If Not (KeyAscii >= 48 And KeyAscii <= 57) And Not (KeyAscii = 13 Or KeyAscii = 8) And Not (KeyAscii >= 1 And KeyAscii <= 26) Then
KeyAscii = 0
Beep
MsgBox "Only numbers are allowed", vbInformation, "Data Entry Error"
End If
OnlyNumeric = KeyAscii
End Function

' To allow user to insert only character in the text field

Public Function OnlyChar(KeyAscii As Integer) As Integer
If (KeyAscii >= 48 And KeyAscii <= 57) Then
KeyAscii = 0
Beep
MsgBox "Only Characters are allowed", vbInformation, "Data Entry Error"
End If
OnlyChar = KeyAscii
End Function

' To Block characters to be entered in some places

Function InvalidChar(KeyAscii As Integer) As Integer

If Not (KeyAscii >= 65 And KeyAscii <= 90) And Not (KeyAscii >= 97 And KeyAscii <= 122) And Not (KeyAscii >= 48 And KeyAscii <= 57) And Not (KeyAscii = 13 Or KeyAscii = 8) Then
KeyAscii = 0
MsgBox "Not a valid char"
Beep
End If
InvalidChar = KeyAscii

End Function

' To validate Email

Public Function ValidateEmail(ByVal stremail As String) As Boolean

Dim intPos As Integer
On Error GoTo errval
If Not IsNull(stremail) Then
If Trim(stremail) = "" Then
ValidateEmail = True
Exit Function
End If
End If
intPos = InStr(1, stremail, "@")
If intPos = 0 Or intPos = 1 Then
ValidateEmail = False
Exit Function
End If
If InStr(intPos + 1, stremail, ".") = 0 Then
ValidateEmail = False
Exit Function
End If
ValidateEmail = True
Exit Function
errval:
ValidateEmail = False

End Function

' To Find Combo Box Data

Public Function FindComboData(ByVal cbo As ComboBox, ByVal ID As Integer) As Integer
Dim i As Integer
Dim b As Boolean
b = False
If ID > 0 Then
For i = 0 To cbo.ListCount - 1
If cbo.ItemData(i) = ID Then
b = True
Exit For
End If
Next
End If
If Not b Then
FindComboData = -1
Else
FindComboData = i
End If
End Function

' To Show row Color while Selecting VS Flex Grid Row

Public Function gridcolor(grd As VSFlexGrid) As Boolean

If grd.Rows = 1 Then

Exit Function
End If
Dim i As Integer

Dim lngrow As Long

Dim lngcol As Long
lngrow = grd.Row
lngcol = grd.Col
For i = 1 To grd.Rows - 1
grd.Cell(flexcpBackColor, i, 0, i, grd.Cols - 1) = vbWhite
Next
If grd.Cell(flexcpBackColor, lngrow, 0, lngrow, grd.Cols - 1) = &HC0E0FF Then
grd.Cell(flexcpBackColor, lngrow, 0, lngrow, grd.Cols - 1) = vbWhite
gridcolor = False

Exit Function
End If

If lngrow = 0 Then
Exit Function
Else
grd.Cell(flexcpBackColor, lngrow, 0, lngrow, grd.Cols - 1) = &HC0E0FF
gridcolor = True
End If

End Function

Read more!

Scrolling Form title from right to left with certain interval

'First include the timer in the form.

Private Sub tmrScrollTitle_Timer()
ScrollTitle "Election Commission Nepal", 80, MDIMain
End Sub

Public Sub SetInitialCaption(Cap As String, Spaces As Integer, FormName As Form)
FormName.Caption = Space(Spaces)
FormName.Caption = FormName.Caption + Cap
End Sub


Public Sub ScrollTitle(Cap As String, Spaces As Integer, FormName As Form)
If Not FormName.Caption = "" Then
FormName.Caption = Right(FormName.Caption, (Len(FormName.Caption) - 1))
Else
Call SetInitialCaption(Cap, Spaces, FormName)
End If
End Sub

Read more!

Read Excel File from VB 6.0

This article provides full details on how to retrieve the Excel data in Visual Basic 6.0 application. Just use the code provided in this article and it should work for you. Also there are various comments in the code that helps to understand the code by beginners as well.

See below for the code to retrieve the excel data:

Private Sub LoadExcel(ByVal strSheet As String)

On Error GoTo EErr

'This can be done to directly access excel but you need to add reference for excel

'Dim objExcel As Excel.Application
'Dim objSpread As Excel.Workbook

Dim introw As Integer

Dim strSNo As String
Dim strEntryNo As String
Dim strFName As String
Dim strMName As String
Dim strLName As String
Dim strFather As String

Dim objExcel As Object
Dim objSpread As Object
Dim introw As Integer

' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)

' This is done to avoid unnecessary running excel.exe application in memory
' This closes the excel once it is set to nothing after the work is done
objExcel.UserControl = True

'Decide the row from which you want to start reading the excel
introw = 1
' Now reading the excel file row by row after opening the excel File

Do Until objExcel.Rows.Count = 113

strEntryNo = Trim(objExcel.Cells(introw, 2).Value)
strFName = Trim(objExcel.Cells(introw, 3).Value)
strMName = Trim(objExcel.Cells(introw, 4).Value)
strLName = Trim(objExcel.Cells(introw, 5).Value)
strFather = Trim(objExcel.Cells(introw, 6).Value)
introw = introw + 1
Loop

' This is essential to close the excel file
objExcel.Quit
Set objSpread = Nothing
Set objExcel = Nothing

Exit Sub
EErr:
' This is essential to close the excel file
objExcel.Quit
Set objSpread = Nothing
Set objExcel = Nothing
Err.Raise Err.Number, Err.Source, Err.Description

End Sub

Read more!

Read from Excel File from VB 6.0

Private Sub LoadExcel(ByVal strSheet As String)

On Error GoTo EErr

'This can be done to directly access excel but you need to add reference for excel

'Dim objExcel As Excel.Application
'Dim objSpread As Excel.Workbook

Dim intRow As Integer

Dim strSNo As String
Dim strEntryNo As String
Dim strFName As String
Dim strMName As String
Dim strLName As String
Dim strFather As String

dim objExcel as object
dim objSpread as object
dim introw as integer

' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)

' This is done to avoid unnecessary running excel.exe application in memory
' This closes the excel once it is set to nothing after the work is done
objExcel.UserControl = True

'Decide the row from which you want to start reading the excel
introw=1
' Now reading the excel file row by row after opening the excel File

Do Until objExcel.Rows.Count = 113

strEntryNo = Trim(objExcel.Cells(intRow, 2).Value)
strFName = Trim(objExcel.Cells(intRow, 3).Value)
strMName = Trim(objExcel.Cells(intRow, 4).Value)
strLName = Trim(objExcel.Cells(intRow, 5).Value)
strFather = Trim(objExcel.Cells(intRow, 6).Value)
intRow = intRow + 1
Loop

' This is essential to close the excel file
objExcel.Quit
Set objSpread = Nothing
Set objExcel = Nothing

Exit Sub
EErr:
' This is essential to close the excel file
objExcel.Quit
Set objSpread = Nothing
Set objExcel = Nothing
Err.Raise Err.Number, Err.Source, Err.Description


End Sub

Read more!