文档视界 最新最全的文档下载
当前位置:文档视界 › vba修改access数据库

vba修改access数据库

使用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

相关文档