如何用vba代码将access数据库连接求代码?

Microsoft Office Access是由微软发布的关系数据库管理系统。它结合了 MicrosoftJet Database Engine 和 图形用户界面两项特点，是 Microsoft Office 的系统程序之一。用vba代码将access数据库连接求代码，代码如下：

Sub FYMXDL()

Dim XQID As Integer

Dim JZID As Integer

Dim FYID As Integer

Dim FBXZ As String '分包性质

Dim DW As String

Dim SARR(1 To 31) As Double

Dim rst As New ADODB.Recordset

mYpath = ThisWorkbook.Path &"\jzfydata.accdb"

Set cONn = CreateObject("ADODB.Connection")

cONn.ConnectionString = "Provider=Microsoft.Ace.OleDB.12.0Data Source=" &mYpath

cONn.ConnectionString = cONn.ConnectionString &"Jet OLEDB:Database "

cONn.Open

XQID = Cells(3, 2).Value

JZID = Cells(3, 5).Value

'清空改小区-建筑的费用明细

Sql = "delete  from fymxb where 小区ID=" &XQID &" AND 建筑ID = " &JZID

cONn.Execute Sql

Const kshh = 7

hh = kshh

Do While Cells(hh, 3).Value >0

FYID = Cells(hh, 3).Value

FBXZ = Cells(hh, 11).Text

For i = 1 To 31

SARR(i) = Round(Cells(hh, 13 + i - 1).Value, 2)

Next i

Sql = Sql &"," &SARR(i)

Next i

Sql = Sql &" )"

cONn.Execute Sql

hh = hh + 1

Loop

End Sub

一、导入方法：

Sub 把Excel数据插入数据库中()

Dim conn As ADODB.Connection

Dim WN As String

Dim TableName As String

Dim sSql As String

Dim tStr As String

'数据库名，请自行修改，路径与当前工作簿在同一目录

WN = "进销存表.mdb"

'数据库的表名与当前工作表名一致

TableName = ActiveSheet.Name

Set conn = New ADODB.Connection

conn.ConnectionString = "Provider=Microsoft.Jet.Oledb.4.0" &_

"Extended Properties=Excel 8.0" &_

"Data Source=" &ThisWorkbook.Path &"\" &ActiveWorkbook.Name

conn.Open

If conn.State = adStateOpen Then

sSql = "Insert Into [DataBase=" &ActiveWorkbook.Path &"\" &WN &"]." &TableName &" Select * From [" &ActiveSheet.Name &"$]"

conn.Execute sSql

MsgBox "成功把数据插入到“" &TableName &"”中！", , "http://excelba.com"

conn.Close

End If

Set conn = Nothing

End Sub

二、EXCEL的使用技巧：

（1） 分数的输入

如果直接输入“1/5”，系统会将其变为“1月5日”，解决办法是：先输入“0”，然后输入空格，再输入分数“1/5”。

（2） 序列“001”的输入

如果直接输入“001”，系统会自动判断001为数据1，解决办法是：首先输入“'”（西文单引号），然后输入“001”。

（3） 日期的输入

如果要输入“4月5日”，直接输入“4/5”，再敲回车就行了。如果要输入当前日期，按一下“Ctrl+；”键。

（4） 填充条纹

如果想在工作簿中加入漂亮的横条纹，可以利用对齐方式中的填充功能。先在一单元格内填入“*”或“~”等符号，然后单击此单元格，向右拖动鼠标，选中横向若干单元格，单击“格式”菜单，选中“单元格”命令，在d出的“单元格格式”菜单中，选择“对齐”选项卡，在水平对齐下拉列表中选择“填充”，单击“确定”按钮。

（5） 多张工作表中输入相同的内容

几个工作表中同一位置填入同一数据时，可以选中一张工作表，然后按住Ctrl键，再单击窗口左下角的Sheet1、Sheet2......来直接选择需要输入相同内容的多个工作表，接着在其中的任意一个工作表中输入这些相同的数据，此时这些数据会自动出现在选中的其它工作表之中。输入完毕之后，再次按下键盘上的Ctrl键，然后使用鼠标左键单击所选择的多个工作表，解除这些工作表的联系，否则在一张表单中输入的数据会接着出现在选中的其它工作表内。

（6） 不连续单元格填充同一数据

选中一个单元格，按住Ctrl键，用鼠标单击其他单元格，就将这些单元格全部都选中了。在编辑区中输入数据，然后按住Ctrl键，同时敲一下回车，在所有选中的单元格中都出现了这一数据。

（7） 在单元格中显示公式

如果工作表中的数据多数是由公式生成的，想要快速知道每个单元格中的公式形式，以便编辑修改，可以这样做：用鼠标左键单击“工具”菜单，选取“选项”命令，出现“选项”对话框，单击“视图”选项卡，接着设置“窗口选项”栏下的“公式”项有效，单击“确定”按钮（如图2）。这时每个单元格中的分工就显示出来了。如果想恢复公式计算结果的显示，就再设置“窗口选项”栏下的“公式”项失效即可。

（8） 利用Ctrl＋*选取文本

如果一个工作表中有很多数据表格时，可以通过选定表格中某个单元格，然后按下Ctrl＋*键可选定整个表格。Ctrl＋*选定的区域为：根据选定单元格向四周辐射所涉及到的有数据单元格的最大区域。这样我们可以方便准确地选取数据表格，并能有效避免使用拖动鼠标方法选取较大单元格区域时屏幕的乱滚现象。

（9） 快速清除单元格的内容

如果要删除内容的单元格中的内容和它的格式和批注，就不能简单地应用选定该单元格，然后按Delete键的方法了。要彻底清除单元格,可用以下方法：选定想要清除的单元格或单元格范围；单击“编辑”菜单中“清除”项中的“全部”命令，这些单元格就恢复了本来面目。

当然可以，用DAO，可以在VB添加DAO组件。

然后，定义参数

'Database Connection

Dim cn As Workspace

Dim db As Database

Dim Rs As Recordset

Dim YOURPWD$, strSQL$, sContent$

'设置数据库

Set cn = DBEngine.Workspaces(0)

Set db = cn.OpenDatabase(sDbPath, False, False, "pwd=" &YOURPWD)

'打开数据库

strSQL = "Select * From YourTable"

Set Rs = db.OpenRecordset(strSQL, , dbReadOnly)

'取出一个不为NULL的字符串字段值

sContent = trim$(Rs!Item1)

--------------------------------------------------------------

'使用前提在VB中加入VB组件

Dim xlsApp As Object, xlsBook As Object, xlsSheet As Object

Dim Row&, Col&

On Error GoTo ExcelInport_Err

'创建应用Excel程序

Set xlsApp = CreateObject("Excel.Application")

'Excel WorkBook 的添加

Set xlsBook = xlsApp.Workbooks.Add

’取得活动的Excel Sheet

Set xlsSheet = xlsBook.ActiveSheet

'Excel Sheet的标题

xlsSheet.Name = "Your Sheet Name"

'Excel Sheet 内容的填充

With xlsSheet

Row = 1

'行

Col = 1

'列

.Cells(Row, Col).Value = "Your Fill Content"

End With

‘Excel

xlsApp.Visible = True

Set xlsSheet = Nothing

Set xlsBook = Nothing

Set xlsApp = Nothing

Exit Sub

ExcelInport_Err:

'关闭时没有消息框

xlsApp.DisplayAlerts = False

xlsApp.Quit

Set xlsApp = Nothing

---