Character Search in a Given String
Sub Main ()
‘Get the string from input box and character from another input box
ipbox = InputBox("enter the string to search", "String name")
ipbox1 = InputBox("enter the character to search", "Character")
ipbox2 = InputBox("enter the character to search", "Character")
‘Length of the String
len1 = Len(ipbox)
j = 0
‘For Loop to get character by character
For i = 1 To len1
‘Using Mid(string,start,Length) function to get single character
ret = Mid(ipbox, i, 1)
re = Mid(ipbox, i, 1)
‘if the single character matches input character then the count increase by 1
If ret = ipbox1 Then
j = j + 1
End If
If re = ipbox2 Then
'k = k + 1
'End If
Next
‘Retrieving the number of character in Message Box
MsgBox "Number of " & ipbox1 & " in the string " & ipbox & " is " & j
MsgBox "Number of " & ipbox2 & " in the string " & ipbox & " is " & k
End Sub
‘End Script
Sub Main ()
‘Create object using scripting.filesystemobject
Set fs = CreateObject("Scripting.Filesystemobject")
‘Open the Text file and set to variable
Set f = fs.opentextfile("c:\documents and settings\thirupathi\desktop\thiru.txt")
‘While loop for getting line by line till end of line
While f.atendofline <> True
x = f.readline
MsgBox x
‘Close the Text file
f.close
Wend
End Sub
Sub main()
ibox = InputBox("Enter number between 1 to 5", "number")
‘call function validate
validate (ibox)
End Sub
‘Function
Function validate(number)
‘Select Case statement
Select Case number
Case 1
MsgBox "Select 1"
Case 2
MsgBox "Select 2"
Case 3
MsgBox "select 3"
Case 4
MsgBox "select 4"
Case 5
MsgBox "select 5"
End Select
End Function
Script: How to handle HTML Table
Retrieving the exact data from HTML Table
Sub main()
‘Declare the table as THTMLTable
‘Declare the table data as THTMLTD
Dim h, z As Integer
Dim tab1 As THTMLTable
Dim td As THTMLTD
Dim td1 As THTMLTD
‘Set the table with the Table ID
Set tab1 = HTMLTable("ID =")
‘Set the table data with the Table ID and Index of the particular cell
Set td = HTMLTD("ID= '' Index = 5")
Set td1 = HTMLTD("ID= '' Index = 6")
‘retrieving the data of the cell
r = td.Text
MsgBox r
s = td1.Text
MsgBox s
‘retrieving the Table Height and Table Width
h = tab1.Height
z = tab1.Width
MsgBox h
MsgBox z
End Sub
‘End Script
Sub main()
‘Declare the table as THTMLTable
Dim a As THTMLTable
‘Set the table with the Table ID
Set a = HTMLTable("ID= ")
‘In table Table items is set variable
r = a.Items.Count
c = a.Items(1).Count
‘Loop for getting data one by one
For i = 1 To r
For j = 1 To c
‘Retrieve all the data in the Table
val1 = a.Items(i).Item(j)
MsgBox val1
Next
Next
End Sub
‘End Script
‘Declare the array fir(500) and sec(500) to store line by line string
‘Declare j,k as variant
Dim frec As String
Dim srec As String
Dim fir(500), sec(500) As String
Dim j, k As Variant
Dim fs
Sub main()
j = 1
k = 1
‘Create the object using “scripting.filesystemobject” and set it to fs
Set fs = CreateObject("scripting.filesystemobject")
‘Open the corresponding file “file1” to compare. Make it as 1st File number
Open "c:\Documents and Settings\Thirupathi\Desktop\thiru.txt" For Input As #1
‘while loop till end of file
While Not EOF(1)
‘Each and every line of text file is passed to “frec”
Line Input #1, frec
‘storing “frec” to array
fir(j) = frec
j = j + 1
Wend
‘Close the File
Close #1
‘Open the corresponding file “File 2” to compare. Make it as 1st File number
Open "c:\Documents and Settings\Thirupathi\Desktop\thiru1.txt" For Input As #1
‘while loop till end of file
While Not EOF(1)
‘Each and every line of text file is passed to “srec”
Line Input #1, srec
‘storing “srec” to array
sec(k) = srec
k = k + 1
Wend
‘Close the File
Close #1
‘Create the new text file using createtextfile() method
Set ws = fs.createtextfile("C:\xxx.txt", True)
‘For loop for each and every line
For i = 1 To j
‘Condition for comparing line by line check on both the text files
If fir(i) = sec(i) Then
‘If both the line matches
‘Write the status to the newly created file
ws.WriteLine ("Line Number: " & i & " Same" & " " & fir(i) & " " & sec(i))
Else
‘If both the line not matches
‘Write the status to the newly created file
ws.WriteLine ("Line Number: " & i & " Not Same" & " " & fir(i) & " " & sec(i))
End If
Next
‘Close the created file
Ws.close
End Sub
‘End Script
Script to retrieve all the data from html table
Sub Main ()
' Declare THTML Table
Dim a As THTMLTable
Set a = HTMLTable("ID= ")
' get the data using a.items.count
r = a.Items.Count
c = a.Items(1).Count
' get the input through inputbox
st = InputBox("Enter the contents")
' Loop to get all the data from table
For i = 1 To r
For j = 1 To c
val1 = a.Items(i).Item(j)
' String comparison of input value and found value
celltext = StrComp(st, val1, vbTextCompare)
' if condition: if the string matches the boolean value is 0
' otherwise 1
If celltext = 0 Then
'Display the data in msgbox
MsgBox val1
End If
Next
Next
End Sub
‘End Script
Script for connecting to the Database (Retrieving All the Data)
'In Tools -> References Select "Microsoft Active Data Object 2.7 Library
'Select "Microsoft Active Data Object Record Set 2.7 Library
Sub Main ()
'Declare new ADODB.connection
'Declare new ADODB.recordset
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
'Open the connection using DSN
con.Open "DSN=Testdsn1"
' Sql Query to retrieve the Entire Data in Table
sql = "select * from phone"
' Open the Recordset using sql, connection, adopendynamic ,ad lockoptimistic
rs.Open sql, con, adOpenDynamic, adLockOptimistic
'Create while - loop for getting one by one record till EOF
While rs.EOF <> True
ret = rs(0)
re = rs(1)
MsgBox rs(0) & " " & rs(1)
rs.MoveNext
Wend
'Close the connection
con.Close
End Sub
‘End Script
Script for connecting to the Database (Writing Data)
'In Tools -> References Select "Microsoft Active Data Object 2.7 Library
'Select "Microsoft Active Data Object Record Set 2.7 Library
Sub Main ()
'Declare new ADODB.connection
'Declare new ADODB.recordset
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
'Open the connection using DSN
con.Open "DSN=Testdsn1"
' Sql Query to retreive the Entire Data in Table
sql = "select * from phone"
' Open the Recordset using sql, connection, adopendynamic ,ad lockoptimistic
rs.Open sql, con, adOpenDynamic, adLockOptimistic
‘Adding New record
rs.addnew
rs(0) = “Thirupathi”
rs(1)= “123456”
‘Updating the Record
rs.update
'Close the connection
con.Close
End Sub
‘End Script
Script using ACTIVE X . dll (i.e.) Handling DLL with USERFORM as Front End
‘Initially Create Active X dll in Visual Basic 6.0
‘Select Active X dll from New Project
‘In the Class module write the function ADD, SUBTRACT, MUL, DIV
‘Function 1
‘get arguments through variable “a” and “b”
Sub add(a As Integer, b As Integer)
Dim c As Integer
c = a + b
MsgBox c
End Sub
‘Function 2
‘get arguments through variable “a” and “b”
Sub subtract(a As Integer, b As Integer)
Dim c As Integer
c = a - b
MsgBox c
End Sub
‘Function 3
‘get arguments through variable “a” and “b”
Sub mul(a As Integer, b As Integer)
Dim c As Integer
c = a * b
MsgBox c
End Sub
‘Function 4
‘get arguments through variable “a” and “b”
Sub div(a As Integer, b As Integer)
Dim c As Integer
c = a / b
MsgBox c
End Sub
‘End Function
‘Save as “arithmetic.dll”
‘make arithmetic.dll from File -> Make arithmetic.dll
<!--[endif]--> ‘In Test Partner Create Userform “ Asset Browser -> Userform -> New Userform
‘Create Label, Text Box and Command Button in Form as shown below
<!--[endif]-->‘In Code Editor write the following code
Dim s As Integer
Dim z As Integer
‘
Dim temp As New Class1
‘write the caption = “ADD” and name = “addition” for command button 1
Private Sub addition_Click()
s = TextBox1.Text
z = TextBox2.Text
‘Call the Function “Addition”
‘Pass Arguments through “s”, “z”
Call temp.Add(s, z)
End Sub
‘write the caption = “SUB” and name = “subtract” for command button 2
Private Sub subtract_Click()
s = TextBox1.Text
z = TextBox2.Text
‘Call the Function “Subtract”
‘Pass Arguments through “s”, “z”
Call temp.subtract(s, z)
End Sub
‘write the caption = “MUL” and name = “multiply” for command button 3
Private Sub multiply_Click()
s = TextBox1.Text
z = TextBox2.Text
‘Call the Function “Multiply”
‘Pass Arguments through “s”, “z”
Call temp.mul(s, z)
End Sub
‘write the caption = “DIV” and name = “division” for command button 4
Private Sub divide_Click()
s = TextBox1.Text
z = TextBox2.Text
‘Call the Function “Divide”
‘Pass Arguments through “s”, “z”
Call temp.div(s, z)
End Sub
‘End Function
‘Save as “User1”
<!--[endif]--> ‘In Test Partner create New Script and Name as “handlingDLL”
‘In VBA code window write the following Code
Sub Main ()
‘Including the Userform “user1”
Include "user1"
User1.Show
End Sub
‘End Script
Script for Handling Active X control using “Data Grid”
1.‘In Visual Basic 6.0 select Standard EXE from New Project
2‘Add Reference to the project by selecting “Project -> Components -> Microsoft DataGrid
‘Control 6.0(OLEDB) and Microsoft ADO Data Control 6.0 (OLEDB)
3.‘Add the “adodc” and “DataGrid” to the form by double clicking the corresponding component from ‘the left pane of the visual basic window.
4.‘Write Click ADODC in the form and select ADODC Properties
5.‘In property pages click “use ODBC Data Source Name”. Select from the existing DSN or Create a new DSN and link the database.
6.‘Goto “RecordSource” and select “2. adCmdTable” from Command Type
7.‘Select “Table Name” from Table or Store Procedure
8.‘Click “Apply” and “ok”
9.‘In DataGrid Properties Select DataSource “ADODC1”
10.‘Press F5 to run the project. The DataGrid display the rows and columns of the Table in the Database
11. ‘Make EXE file by “File -> Make “project name”.exe
<!--[endif]--> In Test Partner write the following code
Sub main()
‘Declare Tactive X
Dim a As TActiveX
‘Identify the Data Grid and set to the variable
Set a = ActiveX("Name=DataGrid1 ClassName=DataGrid")
‘Retrieving the rows and columns
r = a.Object.visiblerows
c = a.Object.visiblecols
‘Get the Text from input box
string1 = InputBox("Enter the Name")
‘Link the row and column to the corresponding variables
For ir = 0 To r - 1
a.Object.row = ir
For ic = 0 To c - 1
a.Object.col = ic
‘Get the Cell Text at the cursor position
d = a.Object.Text
‘Compare the input text to the obtained text and the result will be in Boolean
celltext = StrComp(string1, d, vbTextCompare)
‘Condition: If celltext value is 0 then display the rows
If celltext = 0 Then
MsgBox "Text in Row: " & ir & " Column: " & ic
End If
Next
Next
End Sub
‘End Script
‘Save the script as “handlingDLL”
Reading Sheet 1 and Sheet 2 from Single excel file and
The difference in two Sheets is update in Sheet 3
‘Initially go to “Tools -> References”. Select “Microsoft Scripting Runtime” for activating File system ‘object.
Dim x(100, 100), y(100, 100) As Variant
Dim m, n, p, q As Variant
Dim db As New FileSystemObject
Sub Main ()
'Declare "a" and "b" as object
Dim a, b As Object
'Create Excel application and set to variable "a"
Set a = CreateObject("excel.application")
'Open the Sheet 1 from work book and set to variable "b"
Set b = a.Workbooks.Open("c:\num.xls").Sheets(1)
'Get the used range rows and columns
r = b.usedrange.rows.Count
c = b.usedrange.columns.Count
'Loop for getting cell by cell value
For i = 1 To r
For j = 1 To c
'Assign cell value to Array of "x(i,j)"
x(i, j) = b.cells(i, j).Value
Next
Next
'Open the Sheet 2 from work book and set to variable "b"
Set b = a.Workbooks.Open("c:\num.xls").Sheets(2)
'Get the used range rows and columns
r = b.usedrange.rows.Count
c = b.usedrange.columns.Count
'Loop for getting cell by cell value
For k = 1 To r
For l = 1 To c
y(k, l) = b.cells(k, l).Value
Next
Next
'Open the Sheet 3 for writing
Set b = a.Workbooks.Open("c:\num.xls").Sheets(3)
'Create object for text file
Set fs = CreateObject("scripting.filesystemobject")
'Create text file to store the Error message
Set ws = fs.CreateTextFile("C:\log.txt", True)
‘Write the General Text
ws.WriteLine ("Note: Cell in the order (row : Col
‘Write blank lines
ws.WriteBlankLines (2)
'Loop for writing the value in cell by cell
For m = 1 To r
For n = 1 To c
'Condition statement to check the string from sheet 1 and sheet 2 is same. If it is not same write
'the difference in Sheet 3
If x(m, n) = y(m, n) Then
Else
'Write the difference in Sheet 3
b.cells(m, n).Value = m & ":" & n & " " & "The difference is " & x(m, n) & " " & y(m, n)
'Write the Error in Text file for reference
ws.WriteLine ("Error in cell " & m & ":" & n)
End If
Next
Next
'Save the Active work book
b.Application.Activeworkbook.Save
'Close the Active work book
b.Application.Activeworkbook.Close
'Close the Text file
ws.Close
End Sub
'End Script
0 comments:
Post a Comment