http://www.thescripts.com/forum/thread762010.html
-VB 6.0 Professional
-Microsoft DAO 3.6 Reference
Search Database table...
An attempt to fetch data housed in Access:
(1) This program attempts to search actual data in an Access database
(2) Build an Access database table with 5 text fields
(3) Read code below, add these fields starting with Your_Price as names
(4) Each field must correspond with the field names shown here in VB
(5) You must have an array of 5 textboxes, first in line Text1(0).Text
(6) You will need a fancy command button called whatever you want, 'Seek'
(7) ADD Microsoft DAO 3.6 Object Library
(8) Add code below...
Expand|Select|Wrap|Line Numbers
- Option Explicit
- Option Base 1 'this option makes it that the program starts at number 1, always...
- Dim io() As String 'dimensioning for array to return values
- Dim prs_calc As Integer 'dimensioning to record person instances
- Dim ndvdl, filenum1 As Integer 'dimensioning to record instances for each instance of a person
- Dim my_string As String
- 'Your input box for instances being entered
- 'Your buttons will disapear depending on number added in for each entry
- Private Sub Form_Load()
- ndvdl = Int(InputBox("Add a number to box to continue", "Data Mining Required Info", 1)) 'this is the pop-up box for entry of persons by the user
- 'making sure only digits are entered
- If IsNumeric(ndvdl) = False Then
- MsgBox ("Please add numeric data to continue...")
- 'LoadTFile.Visible = False
- Else 'If IsNumeric(Text3.Text) = True Then
- ReDim io(ndvdl, 5) 'redimensioned for the purpose of data rows calculator
- prs_calc = 1
- End If
- End Sub
- 'this is searching for existing data in local Access database
- Private Sub Seek_Click()
- Dim my_database As Database 'dimension database as database so program knows where to look for data
- Dim my_record As Recordset
- Dim test As String
- test = Text1(1).Text
- Set my_database = OpenDatabase("C:\DataGram\Data_Central.mdb") 'this function will open the database using the link to the access database (provided that it is closed access)
- Set my_record = my_database.OpenRecordset("SELECT * FROM LIBRARY WHERE Your_Price LIKE '" & Text1(0).Text & "'") ' this is used to search by name, only if data already exists
- Do While Not my_record.EOF 'this function will keep searching for fields matching each textbox
- 'MsgBox ("got here")
- Text1(0).Text = my_record.fields("Your_Price")
- Text1(1).Text = my_record.fields("Name")
- Text1(2).Text = my_record.fields("Type")
- Text1(3).Text = my_record.fields("Crime_Rate_1")
- Text1(4).Text = my_record.fields("Crime_Rate_2")
- my_record.MoveNext
- Loop
- my_database.Close
- End Sub
http://www.thescripts.com/forum/thread762010.html
SQL Server Management Studio Express helps load data gathered there to local Access DB, or vice versa...
SQL Server Management Studio Express facilitates query building. Use the query builder, appropriately named, to allow querying Access databases and others.
The SQL Server management tool is essential to the data that must be available to VB/VBA for futher observation. Please download SQL Server Management Studio to make data available to VB/VBA applications
http://www.microsoft.com/downloads/d...displaylang=en
-VB 6.0 Professional
-Microsoft DAO 3.6 Reference
Add to Database table...
An attempt to submit data to Access database:
(1) This program attempts to add, delete, update data to the Access database
(2) Build an Access database table with 5 text fields
(3) Read code below, add these fields starting with Your_Price as names
(4) Each field must correspond with the field names shown here in VB
(5) You must have an array of 5 textboxes, first in line Text1(0).Text
(6) You will need a fancy command button called whatever you want, 'Seek'
(7) ADD Microsoft DAO 3.6 Object Library
(8) Add code below...
Expand|Select|Wrap|Line Numbers
- Private Sub subt_Click() 'this function will load entry into database
- 'dim as database to allow vb to interact with Access database seemlessly...
- Dim my_database As Database
- 'open database to allow vb to add data to Access database seemlessly...
- Set my_database = OpenDatabase("C:\DataGram\Data_Central.mdb")
- 'run insert statement query that will load data to your database
- my_database.Execute "insert into Data_Central.LIBRARY(Your_Price, Name, Type, Crime_Rate_1, Crime_Rate_2) Values('" & Text1(0).Text & "','" & Text1(1).Text & "' , '" & Text1(2).Text & "' , '" & Text1(3).Text & "','" & Text1(4).Text & "')"
- my_database.Close
- 'this variable serves to emptying your textboxes, part of reset button
- R_Click
- End Sub
Expand|Select|Wrap|Line Numbers
- Private Sub dll_Click()
- 'dim as database to allow vb to interact with Access database seemlessly...
- Dim my_database As Database
- 'dim as Recordset to allow vb to interact with Access database seemlessly...
- Dim my_record As Recordset
- 'open database to allow vb to delete data from Access database seemlessly...
- Set my_database = OpenDatabase("C:\DataGram\Data_Central.mdb")
- 'run delete statement query that will remove data from your database
- Set my_record = my_database.OpenRecordset("select * from LIBRARY where Your_Price='" & Text1(0).Text & "'")
- If Not my_record.EOF Then
- my_record.Delete
- End If
- my_database.Close
- 'variable that should empty textboxes for future instances...
- R_Click
- End Sub
Expand|Select|Wrap|Line Numbers
- Private Sub Updt_Click()
- 'dim as database to allow vb to interact with Access database seemlessly...
- Dim my_database As Database
- 'dim as Recordset to allow vb to interact with Access database seemlessly...
- Dim my_record As Recordset
- 'run a little check to see if proper credentials are added before releasing info...
- If (Text1(0) = "") Then
- MsgBox ("Please put in Your price..."), vbOKOnly, "Data Mining Error"
- ElseIf (Text1(1) = "") Then
- MsgBox ("Please put in Item name..."), vbOKOnly, "Data Mining Error"
- Else
- 'open database to allow vb to update data to Access database seemlessly...
- Set my_database = OpenDatabase("C:\DataGram\Data_Central.mdb")
- 'run update statement query that will modify data to your database
- Set my_record = my_database.OpenRecordset("SELECT * FROM LIBRARY WHERE Your_Price='" & Text1(0).Text & "'")
- my_record.Edit
- my_record!Your_Price = Text1(0).Text
- my_record!Name = Text1(1).Text
- my_record!Type = Text1(2).Text
- my_record!Crime_Rate_1 = Text1(3).Text
- my_record!Crime_Rate_2 = Text1(4).Text
- my_record.Update
- my_record.Close
- my_database.Close
- End If
- End Sub
Expand|Select|Wrap|Line Numbers
- Private Sub R_Click() 'this must clear the textbox upon entry of all data
- Text1(0).Text = ""
- Text1(1).Text = ""
- Text1(2).Text = ""
- Text1(3).Text = ""
- Text1(4).Text = ""
- Text1(0).SetFocus 'this should set index back to first textbox
- End Sub
-Add Microsoft XML v 3.0
-Add code below
Contiued from:
http://www.thescripts.com/forum/thread777267.html
-VB 6.0 Professional
-Microsoft XML v3.0 Reference
Converting Access Data to XML file...
An attempt to convert data from Access database to XML:
(1) This program attempts to transform Access data to XML
(2) Use Existing database table, load above code
(4) Each field must correspond with the field names shown here in VB
(5) You will need a fancy command button called whatever you want, 'Seek'
(6) ADD Microsoft XML v3.0 Object Library, in References
(7) Add Microsoft DAO 3.6 Object Library
(8) Add code below...
Expand|Select|Wrap|Line Numbers
- Private Sub CreateXMFile_Click()
- 'dim as database to allow vb to interact with Access database seemlessly...
- Dim my_database As Database
- 'dim as Recordset to allow vb to interact with Access database seemlessly...
- Dim objRS As Recordset
- dimension your FreeFile
- Dim intFreeFile
- 'open database to allow vb to grab data from Access database seemlessly...
- Set my_database = OpenDatabase("C:\DataGram\Data_Central.mdb")
- 'run query that will collect data from your database
- Set objRS = my_database.OpenRecordset("SELECT Your_Price, Name, Type, Crime_Rate_1, Crime_Rate_2 From LIBRARY")
- intFreeFile = FreeFile
- Open App.Path + "\App_Price.xml" For Output As #intFreeFile
- 'build XML version number, and print column names for readibility...
- Print #intFreeFile, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>"
- Print #intFreeFile, "<!-- File Name: App_Price.xml -->"
- 'printing out nodes and subnodes with data gathered from database...
- Print #intFreeFile, "<Find_It>"
- Do While Not objRS.EOF
- Print #intFreeFile, "<Apartmnt>"
- Print #intFreeFile, "<Your_Price>" & objRS.fields("Your_Price") & "</Your_Price>" _
- & vbCrLf & "<Name>" & objRS.fields("Name") & "</Name>" & vbCrLf & "<Type>" & objRS.fields("Type") & "</Type>" _
- & vbCrLf & "<Crime_Rate_1>" & objRS.fields("Crime_Rate_1") & "</Crime_Rate_1>" _
- & vbCrLf & "<Crime_Rate_2>" & objRS.fields("Crime_Rate_2") & "</Crime_Rate_2>"
- Print #intFreeFile, "</Apartmnt>"
- objRS.MoveNext
- Loop
- Print #intFreeFile, "</Find_It>"
- objRS.Close
- Set objRS = Nothing
- Close intFreeFile
- MsgBox ("What do you know, you have an XML file!")
- 'depending on number of instances added in input box upon entry,
- 'you will have x amount of instances to enter, browse data through this application. Button disappears after your max has been reached:-)
- If (prs_calc = ndvdl) Then 'this logic will take away button CreateXMFile if limit has been reached
- CreateXMFile.Visible = False
- End If
- End Sub
-VB 6.0 Professional
-Microsoft DAO 3.6 Reference
Converting Access Data to TEXT file...
An attempt to convert data from Access database to .txt file:
(1) This program attempts to transform Access data to TEXT file
(2) Use Existing database table as in the above code
(3) Each field must correspond with the field names shown here in VB
(4) You will need a fancy command button called whatever you want, 'Seek'
(5) Add Microsoft DAO 3.6 Object Library
(6) Add code below...
Expand|Select|Wrap|Line Numbers
- Private Sub CreateTXTfile_Click()
- 'dim as database to tell vb we're using an Access database
- Dim my_database As Database
- 'dim as Recordsetto tell vb we're using an Access database Recordset
- Dim objRS As Recordset
- 'add FreeFile so vb creates one locally
- Dim intFreeFile
- 'open the database to grab data
- Set my_database = OpenDatabase("C:\DataGram\Data_Central.mdb")
- 'open the Recordset to grab rows in a query
- Set objRS = my_database.OpenRecordset("SELECT Your_Price, Name, Type, Crime_Rate_1, Crime_Rate_2 From LIBRARY")
- 'initiating FreeFile...
- intFreeFile = FreeFile
- Open App.Path + "\App_Price.txt" For Output As #intFreeFile
- 'Print column names for readibility
- Print #intFreeFile, "Your_Price" & vbTab & "Name" & vbTab & "Type" & vbTab & "Crime_Rate_1" & vbTab & "Crime_Rate_2"
- 'run through database recordset until all data gathered to create TEXT file...
- Do While Not objRS.EOF
- Print #intFreeFile, objRS.fields("Your_Price") & vbTab _
- & objRS.fields("Name") & vbTab & objRS.fields("Type") & vbTab _
- & objRS.fields("Crime_Rate_1") & vbTab _
- & objRS.fields("Crime_Rate_2")
- objRS.MoveNext
- Loop
- 'remember to do this...
- objRS.Close
- 'IMPORTANT to do this to allow database to properly close
- Set objRS = Nothing
- 'primitive way of clearing textboxes, you can do better here
- 'do it with a for loop
- Text1(0).Text = ""
- Text1(1).Text = ""
- Text1(2).Text = ""
- Text1(3).Text = ""
- Text1(4).Text = ""
- 'return to first textbox to continue searching, or other
- Text1(0).SetFocus
- MsgBox ("What do you know, you have Text file(s)!")
- 'close the file after you create it...
- Close intFreeFile
- End Sub
This is a little different. It's necessary to add in a textbox to record number of values to return from the multidimentional array:
(1) A record counter is needed to keep instances program loads per user
(2) An input box is also needed to record instances of your entries
Expand|Select|Wrap|Line Numbers
- Private Sub LoadTFile_Click()
- 'this collection button serves to redeeming all data written to file
- 'to be inputted back into program, dimensioning data and renaming them as "Info"
- 'Info1,2,3 and so on represent io array 1,2,3 so on and so forth
- Dim my_string As String
- Dim Info1 As String
- Dim Info2 As String
- Dim Info3 As String
- Dim Info4 As String
- Dim Info5 As String
- 'Dim Info6 As String
- 'Dim Info7 As String
- 'Dim Info8 As String
- Dim record_cntr, location_cntr As Integer
- Dim user_req As Integer
- Dim bomb
- Dim test_string As String
- Dim X As Integer 'x is a counter
- Dim my_char As String
- Text1(0).Text = Info1
- Text1(1).Text = Info2
- Text1(2).Text = Info3
- Text1(3).Text = Info4
- Text1(4).Text = Info5
- 'Text1(5).Text = Info1
- 'Text1(6).Text = Info1
- 'Text1(7).Text = Info1
- test_string = Text3.Text
- 'test_l = Len(test_string)
- Do While X < 10
- my_char = InStr(X, test_string)
- Select Case my_char
- Case "1"
- Case "2"
- Case "3"
- Case "4"
- Case "5"
- Case "6"
- Case "7"
- Case "8"
- Case "9"
- Case "0"
- Case Else
- MsgBox ("You must enter a number!")
- bomb = 99999
- End Select
- X = X + 1
- Loop
- If IsNumeric(Text3.Text) = False Then
- MsgBox ("Please add numeric data to continue...")
- 'LoadTFile.Visible = False
- Else 'If IsNumeric(Text3.Text) = True Then
- If (bomb <> 99999) Then
- user_req = Int(Text3.Text)
- record_cntr = 1
- filenum1 = FreeFile
- Open App.Path + "\App_Price.txt" For Input As #filenum1 'file is opened as input because it is putting back into the program
- Do While Not EOF(filenum1) 'this do while will work until the end of the file...otherwise it will keep going
- Input #filenum1, Info1, Info2, Info3, Info4, Info5 ', Info6, Info7, Info8
- record_cntr = record_cntr + 1
- Loop
- Close filenum1
- If record_cntr < user_req Then
- MsgBox ("There are only " & (record_cntr - 1) & " records in file, we will show you all records.")
- End If
- Open App.Path + "\App_Price.txt" For Input As #filenum1 'file is opened as input because it is putting back into the program
- location_cntr = 1
- Do While Not EOF(filenum1) 'this do while will work until the end of the file...otherwise it will keep going
- Input #filenum1, Info1, Info2, Info3, Info4, Info5 ', Info6, Info7, Info8
- 'all info in textbox bellow will come through line by line using "my_string.....+vbcrlf"
- If (location_cntr >= (record_cntr - user_req)) Then
- my_string = my_string + Info1 + vbCrLf + Info2 + vbCrLf + Info3 + vbCrLf + Info4 + vbCrLf + Info5 + vbCrLf
- End If
- location_cntr = location_cntr + 1
- Loop
- Close filenum1
- Text2.Text = my_string 'this text box return all data which have been recalled from file on harddrive or disk
- If (prs_calc = ndvdl) Then 'this logic will take away button add if limit has been reached
- LoadTFile.Visible = False
- End If
- End If
- End If
- End Sub
Added info:
-A user counter is also needed with the existing record_cntr
-The record_cntr along with user_req counter allow search by specific number
-A location_cntr is added to pinpoint the exact location of newly added entries
-The location_cntr find the position of the data and record counter loads number
-Textbox mentioned previously will hold number of entries needed to return
Example: if 1 is added in the textbox one row in the multidimensional array is
returned. 2, 3 and so forth would have likely results
Note: Admin or power user pages, using ASP.NET code, were created to load data to an SQL Server Database. This data will now be loaded to a user-defined website for browsing ability. Data management through VB/VBA allows XML/XSL and/or text data to load to below HTML/JavaScript driven website:
http://bytes.com/forum/thread672308.html