vb创建access数据库，并转换记录

Question

想用dao来创建一个access数据库，需要先从sql数据库中读取记录，然后创建access数据库，把sql一个数据库中的一个表的记录转换到access中

Answer 1

创建一个access数据库 我不记得代码了 SQL 到ACCESS倒有个现成的

Answer 2

Private Sub Command1_Click()
Dim backm As Database
SQL = ""
On Error Resume Next
jdt.Max = 180
jdt = 1
Kill App.Path + "\backup\" + Trim(Text2)
FileCopy App.Path + "\backup\backup.mdb", App.Path + "\backup\" + Trim(Text2)
jdt = 10
Set backm = Workspaces(0).OpenDatabase("czic", dbDriverNoPrompt, False, "DSN=czic;UID=sa;PWD=*********;DATABASE=icdb;")
''dbsql.Execute "select * into [;database=C:\quenry\shzc\temp.mdb].sghtmx from buycondetail where 1=2 "
''dbsql.Close
jdt = 20
SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].sys_log from sys_log where 1=1"
backm.Execute SQL
jdt = 30
SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].addedit from addedit where 1=1"
backm.Execute SQL
jdt = 40
SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].badic from badic where 1=1"
backm.Execute SQL
jdt = 50
SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].company from company where 1=1"
backm.Execute SQL
jdt = 60
SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].detail from detail where 1=1"
backm.Execute SQL
jdt = 70SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].dw from dw where 1=1"
backm.Execute SQL
jdt = 80
SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].iccard from iccard where 1=1"
backm.Execute SQL
jdt = 90
SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].icpsw from icpsw where 1=1"
backm.Execute SQL
jdt = 100
SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].jfname from jfname where 1=1"
backm.Execute SQL
jdt = 110
SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].jftype from jftype where 1=1"
backm.Execute SQL
jdt = 120
SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].kjkm from kjkm where 1=1"
backm.Execute SQL
jdt = 130
SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].pass from pass where 1=1"
backm.Execute SQL
jdt = 140
SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].total from total where 1=1"
backm.Execute SQL
jdt = 150
SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].users from users where 1=1"
backm.Execute SQLjdt = 160SQL = "select * into  [;database=" + App.Path + "\backup\" + Trim(Text2) + "].jfkmdm from jfkmdm where 1=1"
backm.Execute SQLMsgBox "数据库整理完成！！请插入一张格式化好的软盘！！"
SQL = App.Path + "\winzip\winzip32.exe " + App.Path + "\backup\" + Trim(Text2)
Shell SQL

Answer 3

用dao来创建一个access数据库
引用DAO3.6
Dim Wrk As Workspace
Set Wrk = DBEngine.Workspaces(0)
Set Dbs = OpenDatabase(DatabasePath, False, False)
Set dbs = DBEngine.Workspaces(0).OpenDatabase(DatabasePath, False, False)
Set tdfNew = dbs.CreateTableDef(TableName & "Outputtemp")
tdfNew.Fields.Append tdfNew.CreateField(Col1, dbText)
tdfNew.Fields.Append tdfNew.CreateField(Col2, dbText)
tdfNew.Fields.Append tdfNew.CreateField(Col3, dbText)
tdfNew.Fields.Append tdfNew.CreateField(Col4, dbText)
dbs.TableDefs.Append tdfNew
我这个方法是VB里的，不知你需要不

Answer 4

不好意思，上面是打开数据库，下面是建立
Dim Wrk As Workspace
Set Wrk = DBEngine.Workspaces(0)
Set Dbs = Wrk.CreateDatabase(App.Path & "\" & DatabaseName & TableName & "Outputtemp.mdb", dbLangChineseSimplified)
Set tdfNew = Dbs.CreateTableDef(TableName)

Answer 5

能不能详细一点阿，主要是想写一个函数，由获取的数据集，另存为一个mdb数据库Private Sub Export2Mdb(pRSet As ADODB.Recordset, sFileName As String)问题解决了马上给分，谢谢了，我是新手，多谢指教！

Answer 6

你不是说了用DAO吗？   既然用DAO  用我的代码可以一个SQL语句就搞定的   当然 连接SQL 需要个ODBC   按你的要求的函数 ， 那你还是老老师实 写个循环吧

Answer 7

提供一个简单取巧得方法，你在程序当前目录建立好一个现成得ACESS裤，里面表结构都建好了，然后需要导数据得时候直接复制ACESS到需要得目录，然后用SQL语句导数据就行了，呵呵，这个方法简单。为了保密，你把当前目录下得ACESS裤后缀改一下就行了。

Answer 8

那我给你段代码参考 
r.Fields(i).Type  就是类型
说实话 用这个办法速度很慢的， 不适合大两数据转换
Function Explistv(ll As ListView, rr As ADODB.Recordset, bt As Boolean) As String
'将ADO记录集直接输出到LISTVIEW
Dim r As New ADODB.Recordset
Dim i As Integer
Dim ITMX As ListItem
Set r = rr
ll.ListItems.Clear
Explistv = ""
'添加标题
If bt = True Then
ll.ColumnHeaders.Clear
For i = 0 To r.Fields.Count - 1
 Explistv = Explistv & Trim("," & r.Fields(i).Name)
    ll.ColumnHeaders.Add , , Trim(" " & r.Fields(i).Name & "__" & r.Fields(i).Type)
Next
End If
'添加内容
Do While Not r.EOF
    Set ITMX = ll.ListItems.Add(, , Trim(" " & r.Fields(0).Value & " "))
    For i = 1 To r.Fields.Count - 1
      '字符型
      ITMX.SubItems(i) = Trim(" " & r.Fields(i).Value & " ")
    Next
r.MoveNext
Loop
r.Close
End Function

Answer 9

老大，能不能留下qq，好向你请教问题
qq：31735258

Answer 10

http://community.csdn.net/expert/Topicview2.asp?id=3226572

Answer 11

分已经给了，麻烦给下面的补充一下，谢谢了
完了还有分Private Sub Export2Mdb(pRSet As ADODB.Recordset, sFileName As String)
  On Error GoTo ErrorHandler'  pRSet.MoveFirst
'  Dim pWrk As DAO.Workspace
'  Set pWrk = DAO.DBEngine.Workspaces(0)
'  Dim pDb As DAO.Database
'  Set pDb = pWrk.CreateDatabase(sFileName, dbLangGeneral, dbEncrypt)
'  Dim pTabDef As DAO.TableDef
'  Set pTabDef = pDb.CreateTableDef("ExportMDB")
'  Dim pField As DAO.Field
'  Dim I As Long
'  For I = 0 To pRSet.Fields.Count
'    Select Case pRSet.Fields(I).Type
'
      Exit Sub
ErrorHandler:
  HandleError False, "Export2Mdb " & c_sModuleFileName & " " & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 4
End Sub