Sub inserttodatabase () Dim DataPath As String Dim SQL As String Const dataname As String = "Yunying.mdb" const TableName as String = "Keyword effect analysis" DataPath = Thisworkbook.path & "\" & Dataname Dim Rng As Range Dim Arr A S 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 = "" Val UEs = "" For j = 1 to 6 fileds = fileds & Arr (1, j) & "," values = values & "'" & Arr (i, J) & "'," ' value converted to text Next j for j = 7 to Rng.Columns.Count F Ileds = 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 (" & Valu ES & ")" Debug.Print SQL Cnnrunsql DataPath, sql ' If i = 2 then Exit Sub Next I End with Set Rng = NothingEnd SubSub Cnnrunsql (ByVal DataPath As String, ByVal SQL As String) ' object variable declaration Dim CNN as Object Dim RS as Object ' database engine--excel as data source Const data_engine as String = "Provider=microsoft.ace.oledb.12.0;data Source= "' Creates an ADO Connection connector instance Set CNN = CreateObject (" ADODB. Connection ") ' on Error Resume Next ' creates an ADO Recordset recordset instance ' Set RS = CreateObject (" ADODB. RecordSet ") ' Connected data source CNN. Open Data_engine & DataPath ' Execute query return recordset CNN. Execute (SQL) ' RS. Open SQL, CNN, 1, 1 ' close Recordset ' RS. Close ' off the connector CNN. Close ' Release object Set RS = Nothing Set CNN = NothingEnd Sub
Import 20161208xlVBA worksheet data into Access