这篇博客介绍了如何使用VB 6.0与Microsoft DAO 3.6库来管理Access数据库，包括数据检索、数据提交、数据转换成XML和文本文件。教程详细阐述了创建数据库表、对应VB字段、使用命令按钮以及添加对象库的步骤，同时也提及了SQL Server Management Studio Express在数据管理中的辅助作用。
续自： http : //www.thescripts.com/forum/thread762010.html
添加的信息：
-VB 6.0专业版
-Microsoft DAO 3.6参考
搜索数据库表...尝试获取Access中存储的数据：
（1）该程序尝试在Access数据库中搜索实际数据
（2）用5个文本字段构建一个Access数据库表
（3）阅读下面的代码，添加以Your_Price开头的这些字段作为名称
（4）每个字段必须与VB中此处显示的字段名称相对应
（5）必须有5个文本框的数组，第一个文本行Text1（0）.Text
（6）您将需要一个精美的命令按钮，名为“ Seek”
（7）添加Microsoft DAO 3.6对象库
（8）在下面添加代码...
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 SQL Server Management Studio Express可帮助将在那里收集的数据加载到本地Access DB，反之亦然。
SQL Server Management Studio Express有助于查询构建。 使用查询生成器（适当命名）可以查询Access数据库和其他数据库。
SQL Server管理工具对于VB / VBA必须可用以进行进一步观察的数据至关重要。 请下载SQL Server Management Studio，以使数据可用于VB / VBA应用程序
http://www.microsoft.com/downloads/d...displaylang=zh-CN-VB 6.0专业版
-Microsoft DAO 3.6参考
添加到数据库表...尝试向Access数据库提交数据：
（1）该程序尝试向Access数据库添加，删除，更新数据
（2）用5个文本字段构建一个Access数据库表
（3）阅读下面的代码，添加以Your_Price开头的这些字段作为名称
（4）每个字段必须与VB中此处显示的字段名称相对应
（5）必须有5个文本框的数组，第一个文本行Text1（0）.Text
（6）您将需要一个精美的命令按钮，名为“ Seek”
（7）添加Microsoft DAO 3.6对象库
（8）在下面添加代码...
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
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
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
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 -添加Microsoft XML v 3.0
-在下面添加代码
续自：
http://www.thescripts.com/forum/thread777267.html-VB 6.0专业版
-Microsoft XML v3.0参考
将访问数据转换为XML文件...尝试将数据从Access数据库转换为XML：
（1）该程序尝试将Access数据转换为XML
（2）使用现有数据库表，加载上面的代码
（4）每个字段必须与VB中此处显示的字段名称相对应
（5）您将需要一个精美的命令按钮，名为“ Seek”
（6）在参考资料中添加Microsoft XML v3.0对象库
（7）添加Microsoft DAO 3.6对象库
（8）在下面添加代码...
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专业版
-Microsoft DAO 3.6参考
正在将访问数据转换为TEXT文件...尝试将数据从Access数据库转换为.txt文件：
（1）该程序尝试将Access数据转换为TEXT文件
（2）使用上面代码中的现有数据库表
（3）每个字段必须与VB中此处显示的字段名称相对应
（4）您将需要一个精美的命令按钮，该按钮的名称为“ Seek”
（5）添加Microsoft DAO 3.6对象库
（6）在下面添加代码...
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 这有点不同。 有必要添加一个文本框来记录要从多维数组返回的值的数量：
（1）需要一个记录计数器来保持每个用户的实例程序负载
（2）还需要一个输入框来记录您的条目的实例
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 添加的信息：
-现有的record_cntr也需要一个用户计数器
-record_cntr和user_req计数器允许按特定编号进行搜索
-添加了location_cntr以查明新添加条目的确切位置
-location_cntr查找数据的位置并记录计数器加载数
-前面提到的文本框将保存返回所需的条目数
示例：如果在文本框中添加1，则多维数组中的一行为
回。 2、3等可能会产生结果
注意：使用ASP.NET代码创建了管理员或超级用户页面，以将数据加载到SQL Server数据库中。 现在，该数据将被加载到用户定义的网站上以进行浏览。 通过VB / VBA进行数据管理，可以将XML / XSL和/或文本数据加载到以下HTML / JavaScript驱动的网站： http : //bytes.com/forum/thread672308.html
扫一扫
876
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
