使用VBA 把EXCEL表自动存入ACCESS数据库中去
2012-04-24 05:44:04| 分类: 计算机 |字号 订阅
Sub xx()
Dim x As New ADODB.Connection
Dim y As New ADODB.Recordset
Dim z As New ADOX.Catalog
Set x = New ADODB.Connection
Set y = New ADODB.Recordset
Set z = New ADOX.Catalog
providers = "Microsoft.ace.oledb.12.0; "
extprops = "extended properties=excel 8.0;"
datas = "data source=" & ThisWorkbook.FullName
datas2 = " data source=" & ThisWorkbook.Path & "\" & https://www.docsj.com/doc/1010483934.html, & ".mdb"
x.Open providers & extprops & datas
z.Create (providers & datas2)
sqls = "select * into sheet3 in '" & ThisWorkbook.Path & "\" & https://www.docsj.com/doc/1010483934.html, & ".mdb' from [sheet1$]"
Set yy = x.Execute(sqls)
Set x = Nothing
Set y = Nothing
Set z = Nothing
End Sub
使用VBA 把EXCEL表自动存入ACCESS数据库中去
Sub abc()
Set x = CreateObject("adodb.connection")
x.Open "provider=Microsoft.ace.oledb.12.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
On Error Resume Next '如果数据库存在则跳过
Set y = CreateObject("adox.catalog") 'ADO没有提供创建Access数据库的功能,用adox
y.create ("provider=microsoft.jet.oledb.4.0;data source=d:\备份数据库1.mdb") '创建access数据库
Sql = "select * into sheet3 in 'd:\备份数据库1.mdb' from [sheet1$]" '写入数据库,创建表名sheet3表,把sheet3内容导入到数据库
Set yy = x.Execute(Sql)
End Sub
这样也行
Sub TEST1()
Dim X1 As ADODB.Connection
Dim x2 As ADODB.Recordset
Dim y1 As String
Dim y2 As String
Set X1 = New ADODB.Connection
Set x2 = New ADODB.Recordset
y1 = "provider=Microsoft.ace.oledb.12.0; extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
y2 = "select * into sheettest2 in '" & ThisWorkbook.Path & "\test.mdb'" & "from [sheet1$]"
'y2 = "SELECT SN FROM [sheet1$]"
X1.Open y1
X1.Execute (y2)
'x2.Open y2, X1
Set X1 = Nothing
Set x2 = Nothing
End Sub
Sub xx()
Dim x4 As Variant
Dim X1, x2, x3 As Object
Dim y1, y2, y3 As String
Set X1 = CreateObject("adodb.connection")
Set x2 = CreateObject("adodb.recordset")
Set x3 = CreateObject("adox.catalog")
'On Error Resume Next
x3.create ("provider=Microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\贷款明细表.mdb")
X1.Open "provider=Microsoft.ace.oledb.12.0; extended properties=excel 8.0; data source=" & ThisWorkbook.FullName
Set x4 = X1.Execute("select * into 贷款明细 in '" & ThisWorkbook.Path & "\贷款明细表.mdb' from [贷款明细$]")
Set X1 = Nothing
Set x2 = Nothing
Set x3 = Nothing
End Sub
把数据库中的数据存到EXCEL表中来
Sub EXCELREADACCESS()
Dim Cnn As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim X1, X2, X As String
Dim Y1, Y2, Y As String
Dim wkb As Workbook
Dim i%
X1 = "PROVIDER=MMicrosoft.ace.oledb.12.0;"
X2 = "Data Source=D:\My Documents\EX
CEL操作ACCESS数据库示例\info.mdb"
X = X1 & X2
Cnn.Open X
Set Y1 = Cnn
Y2 = "select * from 信息 "
Rst.Open Y2, Y1
Set wkb = Workbooks.Add
With wkb
For i = 0 To Rst.Fields.Count - 1
.Sheets(1).Cells(1, i + 1) = Rst.Fields(i).Name
Next i
.Sheets(1).[a2].CopyFromRecordset Rst
.SaveAs "D:\My Documents\EXCEL操作ACCESS数据库示例\ACCESS转EXCEL.xls"
.Close
End With
End Sub