asked on

Insert multiple records to SQL server table by using Excel VBA

I have a VBA code that iserts 1 row at a time, but I need to know how to insert list of records together. I think I should use Loop, but not sure how. here is my code.

Private Sub CommandButton1_Click()
 
Dim cnn As ADODB.Connection
Dim xlSheet As Worksheet
Dim sConnString As String
Dim cmd As ADODB.Command
Dim param As ADODB.Parameter
 
 
Set resultsSheet = Sheets("Sheet1")
resultsSheet.Activate
Range("B2").Activate
 
 
Set paramSheet = Sheets("Sheet1")
 
 
 
Set cnn = New ADODB.Connection
sConnString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
    "Persist Security Info=False;" & _
    "Initial Catalog=database;" & _
    "Data Source=server"
cnn.Open sConnString
 
Set cmd = New ADODB.Command
cmd.ActiveConnection = cnn
 
With cmd
    .CommandType = adCmdStoredProc
    .CommandText = "stored_proc"
End With
 
 
Set param = New ADODB.Parameter
With param
    .Name = "@date"
    .Type = adDate
    .Size = 8
    .Value = paramSheet.Range("B2").Value
End With
cmd.Parameters.Append param
 
   
Set param = New ADODB.Parameter
With param
    .Name = "@account_from "
    .Type = adVarChar
    .Size = 50
    .Value = paramSheet.Range("C2").Value
End With
cmd.Parameters.Append param
 
Set param = New ADODB.Parameter
With param
    .Name = "@account_to"
    .Type = adVarChar
    .Size = 50
    .Value = paramSheet.Range("D2").Value
End With
cmd.Parameters.Append param
 
Set param = New ADODB.Parameter
With param
    .Name = "@symbol"
    .Type = adVarChar
    .Size = 50
    .Value = paramSheet.Range("E2").Value
End With
cmd.Parameters.Append param
 
Set param = New ADODB.Parameter
With param
    .Name = "@transfer_type"
    .Type = adVarChar
    .Size = 50
    .Value = paramSheet.Range("F2").Value
End With
cmd.Parameters.Append param
 
    
   
Set rs = New ADODB.Recordset
Set rs = cmd.Execute
 
 
 
 
 
resultsSheet.Select
Range("B2").Select
Selection.CurrentRegion.Select
 
Range("B2").Select
 
 
cnn.Close
 
Set cmd = Nothing
Set param = Nothing
Set rs = Nothing
Set cnn = Nothing
Set xlSheet = Nothing
    
 
End Sub

Open in new window

Saurabh Singh Teotia

Okay...lets say you want to insert...values from row-2 till the last row basis of B Column...in your data then use this...it will do what you want...

Private Sub CommandButton1_Click()
 
Dim cnn As ADODB.Connection
Dim xlSheet As Worksheet
Dim sConnString As String
Dim cmd As ADODB.Command
Dim param As ADODB.Parameter
 
 
Set resultsSheet = Sheets("Sheet1")
resultsSheet.Activate
Range("B2").Activate
 
 
Set paramSheet = Sheets("Sheet1")
 
 
 
Set cnn = New ADODB.Connection
sConnString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
    "Persist Security Info=False;" & _
    "Initial Catalog=database;" & _
    "Data Source=server"
cnn.Open sConnString
 
Set cmd = New ADODB.Command
cmd.ActiveConnection = cnn
 
With cmd
    .CommandType = adCmdStoredProc
    .CommandText = "stored_proc"
End With
 
Dim lrow As Long, x As Long
lrow = paramSheet.Cells(65536, "b").End(xlUp).Row
 
For x = 2 To lrow
Set param = New ADODB.Parameter
With param
    .Name = "@date"
    .Type = adDate
    .Size = 8
    .Value = paramSheet.Range("B" & x).Value
End With
cmd.Parameters.Append param
 
   
Set param = New ADODB.Parameter
With param
    .Name = "@account_from "
    .Type = adVarChar
    .Size = 50
    .Value = paramSheet.Range("C" & x).Value
End With
cmd.Parameters.Append param
 
Set param = New ADODB.Parameter
With param
    .Name = "@account_to"
    .Type = adVarChar
    .Size = 50
    .Value = paramSheet.Range("D" & x).Value
End With
cmd.Parameters.Append param
 
Set param = New ADODB.Parameter
With param
    .Name = "@symbol"
    .Type = adVarChar
    .Size = 50
    .Value = paramSheet.Range("E" & x).Value
End With
cmd.Parameters.Append param
 
Set param = New ADODB.Parameter
With param
    .Name = "@transfer_type"
    .Type = adVarChar
    .Size = 50
    .Value = paramSheet.Range("F" & x).Value
End With
cmd.Parameters.Append param
 
    
   
Set rs = New ADODB.Recordset
Set rs = cmd.Execute
 
 Next x
 
 
 
 
resultsSheet.Select
Range("B2").Select
Selection.CurrentRegion.Select
 
Range("B2").Select
 
 
cnn.Close
 
Set cmd = Nothing
Set param = Nothing
Set rs = Nothing
Set cnn = Nothing
Set xlSheet = Nothing
    
 
End Sub

Open in new window

ASKER CERTIFIED SOLUTION

aikimark

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial