建立AccessDB

Option Explicit

Private Sub CreateAccDB(ByVal MdbFileName As String) ' 建立 MDB
CreateObject("DAO.DBEngine.36").CreateDatabase _
MdbFileName, ";LANGID=0x0404;CP=950;COUNTRY=0"
End Sub


Private Sub Command1_Click()
Dim strMDBfile As String

strMDBfile = "C:\report\Test.mdb"
If Dir(strMDBfile) = "" Then CreateAccDB strMDBfile
If Dir(strMDBfile) <> "" Then MsgBox "建立完成"

CreateTable2 strMDBfile


End Sub

Sub CreateTable(strMDBfile As String)
Dim cn As ADODB.Connection
Set cn = CreateObject("ADODB.Connection")
Dim rs As ADODB.Recordset
Dim strSql As String
Dim Tbl As New Table
Dim Cat As ADOX.Catalog
Dim i As Integer
'Set Tbl = CreateObject("Table")
Set Cat = CreateObject("ADOX.Catalog")
With cn
.ConnectionString = "provider=sqloledb.1;persist security info=false;user id=sa;password=i513;initial catalog=apcb;data source=apcb08"
.Open
End With

strSql = "select * from K_HubMtl_Stocks"

Set rs = cn.Execute(strSql)

'Dim Tbl As New Table
'Dim Cat As New ADOX.Catalog

Cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strMDBfile & ";"
Tbl.Name = "MyTable"
For i = 0 To rs.Fields.Count - 1
Tbl.Columns.Append rs.Fields(i).Name, adVarWChar, 200
'Select Case rs.Fields(i).Type
' Case 2
' Tbl.Columns.Append rs.Fields(i).Name, adInteger
'Case 135
' Tbl.Columns.Append rs.Fields(i).Name, adDate
' Case 200
' Tbl.Columns.Append rs.Fields(i).Name, adVarChar, rs.Fields(i).DefinedSize
'Case 131
' Tbl.Columns.Append rs.Fields(i).Name, adNumeric, rs.Fields(i).DefinedSize

'End Select
Next i

Cat.Tables.Append Tbl

'塞資料


cn.Close
Set rs = Nothing
Set cn = Nothing
Set Tbl = Nothing
Set Cat = Nothing
End Sub

Sub CreateTable2(strMDBfile As String)
Dim cn As ADODB.Connection
Set cn = CreateObject("ADODB.Connection")

Dim rs As ADODB.Recordset

Dim strSql As String

With cn
.ConnectionString = "provider=sqloledb.1;persist security info=false;user id=sa;password=i513;initial catalog=apcb;data source=apcb08"
.Open
End With

With Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strMDBfile & ";"
.RecordSource = "select * from MyTable"
End With


strSql = "select * from K_HubMtl_Stocks"

Set rs = cn.Execute(strSql)


'以下在用迴圈把資料add到acess裡面...
With rs
Do
Adodc1.Recordset.AddNew .Fields(0).Name, .Fields(0).Value
.MoveNext
While Not .EOF
End With

cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub