Search code examples
excelvbasharepointado

Sending Multiple Cells to my SharePoint with rst.Fields


Pardon any errors my VBA skills are not great.

So, I'm attempting to upload excel data to a SharePoint list and I followed some tutorials to understand how I can accomplish this within a macro and I'm using ADO and SQL to achieve this. I got the connection working because in a separate Macro I was able to pull my data and send singular rows of data but I want to send several rows worth of data in the excel and I tried a common loop but it didn't work. Ideally i'd like it if I could use the Macro to upload Row 2 to Row X (LastRow) I tried looping but either I don't understand the syntax of this or I can't loop it like how I figured I could.

Option Explicit
Sub AddNew_SP()
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim mySQL As String
Dim i As Integer
Dim LastRow As Integer

Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
mySQL = "SELECT * FROM [1];"

'open connection

With cnt
    .ConnectionString = _
    "Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;DATABASE=MySite;LIST=MyGUID;"
    .Open
End With

rst.Open mySQL, cnt, adOpenDynamic, adLockOptimistic
'For i = 2 To LastRow
rst.AddNew
    'rst.Fields("Department")=["A" + "i"]
    'rst.Fields("Section#") = ["B" + "i"]
    'rst.Fields("Operation#") = ["C" + "i"]
    'rst.Fields("Job") = ["D" + "i"]
    'rst.Fields("Program") = ["L" + "i"]
rst.Update
'Next i
If CBool(rst.State And adStateOpen) = True Then rst.Close
Set rst = Nothing
If CBool(cnt.State And adStateOpen) = True Then cnt.Close
Set cnt = Nothing

End Sub

Solution

  • ["B" + "2"] (eg) is not the same as [B2] - using square brackets to refer to ranges in VBA is best avoided: it's not worth saving a few characters over Range(), Cells() etc

    Try this:

    Dim rw As Range
    '...
    '...
    
    rst.Open mySQL, cnt, adOpenDynamic, adLockOptimistic
    For i = 2 To LastRow
         With ActiveSheet.Rows(i)
             rst.AddNew
             rst.Fields("Department")=.Parent.Range("A2").value
             rst.Fields("Section#") = .Cells(2).Value
             rst.Fields("Operation#") = .Cells(3).Value
             rst.Fields("Job") = .Cells(4).Value
             rst.Fields("Program") = .Cells(12).Value
         End with
         rst.UpdateBatch
    Next i