X-Received: by 2002:a05:6214:509a:: with SMTP id kk26mr34226428qvb.43.1636110152550; Fri, 05 Nov 2021 04:02:32 -0700 (PDT)
X-Received: by 2002:a5b:287:: with SMTP id x7mr64955083ybl.309.1636110152324; Fri, 05 Nov 2021 04:02:32 -0700 (PDT)
Path: csiph.com!weretis.net!feeder6.news.weretis.net!news.misty.com!border2.nntp.dca1.giganews.com!nntp.giganews.com!news-out.google.com!nntp.google.com!postnews.google.com!google-groups.googlegroups.com!not-for-mail
Newsgroups: it.comp.lang.visual-basic
Date: Fri, 5 Nov 2021 04:02:31 -0700 (PDT)
Injection-Info: google-groups.googlegroups.com; posting-host=165.225.203.33; posting-account=yvxj_woAAABxrxq8XihQzP-tWUWpycQc
NNTP-Posting-Host: 165.225.203.33
User-Agent: G2/1.0
MIME-Version: 1.0
Message-ID: <30937b09-e13b-4d50-8b2c-aa5acbbd19d0n@googlegroups.com>
Subject: Dati tabella Excel su tabella SQL Server
From: Marco75 <marcoporzi75@gmail.com>
Injection-Date: Fri, 05 Nov 2021 11:02:32 +0000
Content-Type: text/plain; charset="UTF-8"
Lines: 87
Xref: csiph.com it.comp.lang.visual-basic:19931

Ciao,
devo popolare una tabella SQL Server a partire da Excel con VBA.
ho copiato un codice usato in un altro file che funziona benissimo ma in questo file non riesco a farlo funzionare!
Ho un errore in Update del recordset (Errore di sistema &H80040E2F (-2147217873).

questo il codice:

 Dim R1 As String
    
    R1 = MsgBox("Sto per inviare i dati al server..." & vbNewLine & vbNewLine & "Confermi?", vbQuestion + vbYesNo, "Salvataggio dati")
    
    If R1 = vbYes Then
    
    Dim conn As ADODB.Connection
    Dim ServerName As String
    Dim DbName As String
    Dim TableName As String
    Dim UserID As String
    Dim Password As String
    Dim RowCounter As Long
    Dim ColCounter As Integer
    Dim NoOfFields As Integer
    Dim StartRow As Long
    Dim EndRow As Long
    Dim r As Long
    Dim cs As String
    Dim strSQL As String
    Dim lRow As Long
    
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    NoOfFields = 16
    StartRow = 2
    EndRow = lRow
    
    Set conn = New ADODB.Connection
    cs = "DRIVER=SQL SERVER;"
    cs = cs & "DATABASE=StoricoTare;"
    cs = cs & "SERVER=AAA\SQLEXPRESS"
    
    conn.Open cs, "User", "Password"
    
    Dim rs As New ADODB.Recordset
    Set rs = New ADODB.Recordset
   
    
    strSQL = "Select * From T_StoricoTareTest;"
    rs.Open strSQL, conn, adOpenDynamic, adLockOptimistic
    'rs.Open TableName, cn, adOpenKeyset, adLockOptimistic, adCmdTable
    
    r = 2
    
    Do While Len(Range("A" & r).Formula) > 0
    
    With rs
        .AddNew
        .Fields("DataOraInserimento") = Range("Q" & r).Value
        .Fields("Anno") = Range("R" & r).Value
        .Fields("Mese") =Range("S" & R).Value
        .Fields("PianoIspezione") = Range("A" & r).Value
        .Fields("MediaSG") = Range("D" & R).Value
        .Fields("M") = Range("E" & R).Value
        .Fields("Min") = Range("F" & R).Value
        .Fields("Max") = Range("G" & R).Value
        .Fields("DevSt") = Range("H" & R).Value
        .Fields("3Sigma") = Range("I" & R).Value
        .Fields("Scost+") = Range("J" & R).Value
        .Fields("Scost-") = Range("K" & R).Value
        .Fields("ATB+") = Range("L" & R).Value
        .Fields("ATB-") = Range("M" & R).Value
        .Fields("PercentATB_Sup_Inf") = Range("N" & R).Value
        .Fields("MediaArrotondata") = Range("O" & R).Value
        .Update
    End With
    
    r = r + 1
    
    Loop
    rs.Close
    Set rs = Nothing
    conn.Close
    Set conn = Nothing
    
    MsgBox ("I dati sono stati caricati sul server..."), vbInformation + vbOKOnly, "Salvataggio dati"
    
    ElseIf R1 = vbNo Then
    MsgBox ("Salvataggio dati annullato..."), vbInformation + vbOKOnly, "Salvataggio dati"
    End If