如何将excel中的数据用vba代码存入access文件中
2个回答
推荐于2016-03-16 · 知道合伙人数码行家
可以叫我表哥
知道合伙人数码行家
向TA提问 私信TA
知道合伙人数码行家
采纳数:25897
获赞数:1464984
2010年毕业于北京化工大学北方学院计算机科学与技术专业毕业,学士学位,工程电子技术行业4年从业经验。
向TA提问 私信TA
关注
展开全部
以下是我用了实现从Excel导数据进ACCESS的代码,你参考一下,应该就可以做出来了:(Excel和Access两个文件放一个文件夹下)
Public Sub 客户正常供价批量维护()
If Cells(4, 6) = "" Then
MsgBox "请先选择需要维护价格的系统!", vbInformation
Cells(4, 6).Select
Exit Sub
Else
Dim i As Integer, j As Integer, k As Integer, sht As Worksheet 'i,j,k为整数变量;sht 为excel工作表对象变量,指向某一工作表
Dim cn As New ADODB.Connection '定义数据链接对象 ,保存连接数据库信息;请先添加ADO引用
Dim rs As New ADODB.Recordset '定义记录集对象,保存数据表
Dim strCn As String, strSQL As String '字符串变量
Dim mdbFile As String
On Error GoTo add_err
mdbFile = ActiveWorkbook.Path & "\DY_DATA.mdb"
strCn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbFile '定义数据库链接字符串
cn.Open strCn '与数据库建立连接,如果成功,返回连接对象cn
Set rs = New ADODB.Recordset
rs.Open "dbl直营客户正常供价表", cn, adOpenKeyset, adLockOptimistic
k = Cells(4, 8) + 8
For i = 9 To k
If Cells(i, 7) = "" Then
Else
rs.AddNew
rs(1) = Cells(i, 2)
rs(2) = Cells(i, 7)
rs(3) = Cells(i, 8)
rs.Update
Cells(i, 7) = ""
Cells(i, 8) = ""
End If
Next
MsgBox "数据记录添加成功!", vbInformation
Cells(4, 6).Select
ActiveWorkbook.RefreshAll
add_exit:
Exit Sub
End If
add_err:
MsgBox Err() & vbCrLf & Error()
Resume add_exit
End Sub
Public Sub 客户正常供价批量维护()
If Cells(4, 6) = "" Then
MsgBox "请先选择需要维护价格的系统!", vbInformation
Cells(4, 6).Select
Exit Sub
Else
Dim i As Integer, j As Integer, k As Integer, sht As Worksheet 'i,j,k为整数变量;sht 为excel工作表对象变量,指向某一工作表
Dim cn As New ADODB.Connection '定义数据链接对象 ,保存连接数据库信息;请先添加ADO引用
Dim rs As New ADODB.Recordset '定义记录集对象,保存数据表
Dim strCn As String, strSQL As String '字符串变量
Dim mdbFile As String
On Error GoTo add_err
mdbFile = ActiveWorkbook.Path & "\DY_DATA.mdb"
strCn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbFile '定义数据库链接字符串
cn.Open strCn '与数据库建立连接,如果成功,返回连接对象cn
Set rs = New ADODB.Recordset
rs.Open "dbl直营客户正常供价表", cn, adOpenKeyset, adLockOptimistic
k = Cells(4, 8) + 8
For i = 9 To k
If Cells(i, 7) = "" Then
Else
rs.AddNew
rs(1) = Cells(i, 2)
rs(2) = Cells(i, 7)
rs(3) = Cells(i, 8)
rs.Update
Cells(i, 7) = ""
Cells(i, 8) = ""
End If
Next
MsgBox "数据记录添加成功!", vbInformation
Cells(4, 6).Select
ActiveWorkbook.RefreshAll
add_exit:
Exit Sub
End If
add_err:
MsgBox Err() & vbCrLf & Error()
Resume add_exit
End Sub
展开全部
ado+sql语句
Set conn = CreateObject("adodb.connection")
conn.Open = "dsn=****** ;uid=;psw="
conn.Execute ("delete * from sheet2")
Set rs = CreateObject("adodb.recordset")
rs.CursorType = 3
rs.LockType = 3
sql_str = "select * from sheet2"
rs.Open sql_str, conn
i = 2
Do Until Sheets("导入数据").Cells(i, 1) = ""
rs.addnew
rs!zcbm = Sheets("导入数据").Cells(i, 1)
:
:
rs.Update
i = i 1
Loop
j = i - 2
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
Set conn = CreateObject("adodb.connection")
conn.Open = "dsn=****** ;uid=;psw="
conn.Execute ("delete * from sheet2")
Set rs = CreateObject("adodb.recordset")
rs.CursorType = 3
rs.LockType = 3
sql_str = "select * from sheet2"
rs.Open sql_str, conn
i = 2
Do Until Sheets("导入数据").Cells(i, 1) = ""
rs.addnew
rs!zcbm = Sheets("导入数据").Cells(i, 1)
:
:
rs.Update
i = i 1
Loop
j = i - 2
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询