利用vba将excel数据导入指定的access

发布网友 发布时间：2022-04-22 10:49

我来回答

共2个回答

懂视网 时间：2022-04-10 06:12

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

标签：表数   vba   查询   pat   cell   value   row   关闭   数据源   

热心网友 时间：2022-04-10 03:20

Sub 把Excel数据插入数据库中()
'*******************************************
'时间：2010-06-28
'作者：bengdeng
'功能：把当前工作表的数据增加到在程序文件同一目录下进销存表数据库中
'注意：要在工具/引用中引用microsoft activex date objects x.x
' 其中x.x为版本号，可能会因为你安装的office的版本不同而不同，本例引用了2.5版
'发布：http://www.excelba.com
'*******************************************
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