首页 > 代码库 > 20161208xlVBA工作表数据导入Access
20161208xlVBA工作表数据导入Access
Sub InsertToDataBase() Dim DataPath As String Dim SQL As String Const DataName As String = "yunying.mdb" Const TableName As String = "关键词效果分析" DataPath = ThisWorkbook.Path & "\" & DataName Dim Rng As Range Dim Arr As Variant Dim EndRow As Long Dim Fileds As String Dim Values As String With ThisWorkbook.Worksheets(1) EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row Set Rng = .Range("A1:R" & EndRow) Arr = Rng.Value For i = 2 To Rng.Rows.Count Fileds = "" Values = "" For j = 1 To 6 Fileds = Fileds & Arr(1, j) & "," Values = Values & "‘" & Arr(i, j) & "‘," ‘数值转为文本 Next j For j = 7 To Rng.Columns.Count Fileds = Fileds & Arr(1, j) & "," Values = Values & Arr(i, j) & "," Next j Fileds = Left(Fileds, Len(Fileds) - 1) Values = Left(Values, Len(Values) - 1) SQL = "INSERT INTO " & TableName & " (" & Fileds & ") VALUES(" & Values & ")" Debug.Print SQL CnnRunSQL DataPath, SQL ‘If i = 2 Then Exit Sub Next i End With Set Rng = Nothing End Sub Sub CnnRunSQL(ByVal DataPath As String, ByVal SQL As String) ‘对象变量声明 Dim CNN As Object Dim RS As Object ‘数据库引擎——Excel作为数据源 Const DATA_ENGINE As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" ‘创建ADO Connection 连接器 实例 Set CNN = CreateObject("ADODB.Connection") ‘ On Error Resume Next ‘创建 ADO RecordSet 记录集 实例 ‘Set RS = CreateObject("ADODB.RecordSet") ‘连接数据源 CNN.Open DATA_ENGINE & DataPath ‘执行查询 返回记录集 CNN.Execute (SQL) ‘RS.Open SQL, CNN, 1, 1 ‘关闭记录集 ‘RS.Close ‘关闭连接器 CNN.Close ‘释放对象 Set RS = Nothing Set CNN = Nothing End Sub
20161208xlVBA工作表数据导入Access
声明:以上内容来自用户投稿及互联网公开渠道收集整理发布,本网站不拥有所有权,未作人工编辑处理,也不承担相关法律责任,若内容有误或涉及侵权可进行投诉: 投诉/举报 工作人员会在5个工作日内联系你,一经查实,本站将立刻删除涉嫌侵权内容。