Столбец VBA Update в SQL Таблица серверов с данными из Excel - PullRequest
0 голосов
/ 08 февраля 2020

У меня есть книга Excel, которая извлекает данные в таблицу, и пользователи могут заполнить отсутствующие даты в столбце 11. Столбец 1 - это уникальный идентификатор, соответствующий столбцу идентификатора в таблице SQL. Я хочу создать макрос, который запускается при закрытии книги и обновляет таблицу SQL с заполненными датами, но я борюсь с кодом. Я пробовал две разные вещи, но ни одна из них не работает.

Вариант 1:

 Private Sub tableupdate()

 Dim con As New ADODB.Connection
 Dim cmd As New ADODB.Command
 Dim rst As New ADODB.Recordset
 Dim i As Long
 Dim vDB As Variant
 Dim ws As Worksheet

con.connectionstring = "Provider=SQLOLEDB;Password=*********;User ID=clx_write;      Initial Catalog=DPEDataMartDBPrd01; Data Source=tcp:dscusnoramcloroxprd01.database.windows.net,1433;"

con.Open
Set cmd.ActiveConnection = con
Set ws = ActiveSheet

vDB = ws.Range("A4").CurrentRegion

For i = 2 To UBound(vDB, 1)
cmd.CommandText = "UPDATE [dbo].[all_load_control] set Driver_arr_dte = ' " & vDB(i, 2) & " '       WHERE mst_ship_num = ' " & vDB(i, 1) & " ' "
cmd.Execute
Next i

con.Close
Set con = Nothing


End Sub

Вариант 2:

Private Sub uplodblanks()

Dim r, c, con, dstring
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim lRow
Dim ssql As String


con = "Provider=SQLOLEDB;Password=********;User ID=clx_write; Initial   Catalog=DPEDataMartDBPrd01; Data Source=tcp:dscusnoramcloroxprd01.database.windows.net,1433;"

r = 1
c = 1
Worksheets("WTUpload").Calculate


lRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas,  SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
cn.Open con

i = 1
For i = 1 To lRow

ssql = "update dbo.cxu_all_load_control set driver_arr_dte = " &  CDate(Sheets("WTUpload").Cells(i, 11)) & " where mst_ship_num = " & CDbl(Sheets("WTUpload").Cells(i, 11)) & " ; "


cn.Execute ssql

Next i

cn.Close

End Sub

Любая помощь в том, почему ни одна из это работает было бы здорово

1 Ответ

0 голосов
/ 10 февраля 2020

Замените функцию mydbConnect () собственным методом получения соединения.


    Sub tableupdate2()

        Const COL_NUM As String = "A" 
        Const COL_DATE As String = "K" 
        Const TABLE As String = "dbo.all_load_control"

        ' define update sql
        Const SQL  As String = " UPDATE " & TABLE & _
                               " SET Driver_arr_dte = CAST(? AS DATETIME2) " & _
                               " WHERE mst_ship_num = ? "

        ' establish connection and create command object
        Dim con As Object, cmd As Object, sSQL As String
        Set con = mydbConnect() ' establish connection
        Set cmd = CreateObject("ADODB.Command")
        With cmd
            .ActiveConnection = con
            .CommandText = SQL
            .CommandType = 1 'adCmdText
            .Parameters.Append .CreateParameter("P1", adVarChar, 1, 20) '
            .Parameters.Append .CreateParameter("P2", adVarChar, 1, 50) ' adParamInput = 1
        End With

        ' prepare to get data from spreadsheet
        Dim wb As Workbook, ws As Worksheet, iLast As Integer, iRow As Integer
        Set wb = ThisWorkbook
        Set ws = wb.Sheets("WTUpload")
        iLast = ws.Range(COL_NUM & Rows.count).End(xlUp).Row

        Dim p1 As String, p2 As String, count As Long

        ' scan sheet and update db
        Debug.Print "Updates " & Now
        With cmd
            For iRow = 1 To iLast           
               p1 = Format(ws.Range(COL_DATE & iRow).Value, "yyyy-mm-dd hh:mm")
               p2 = ws.Range(COL_NUM & iRow).Value
               If len(p2) > 0 Then
                    .Parameters(0).Value = p1
                    .Parameters(1).Value = p2
                    Debug.Print "Row ", iRow, "p1=" & p1, "P2=" & p2
                    .Execute
                    count = count + 1
                End If
            Next
        End With

        ' end
        MsgBox "Rows processed = " & count, vbInformation, "Updates Complete"
        con.Close
        Set con = Nothing
    End Sub

Edit - added connection and test code

    Function mydbConnect() As Object

        Dim sConStr As String

        sConStr = "Provider=SQLOLEDB;Password=*********;User ID=clx_write;" & _
                  "Initial Catalog=DPEDataMartDBPrd01;" & _
                  "Data Source=tcp:dscusnoramcloroxprd01.database.windows.net,1433;"

        Set mydbConnect = CreateObject("ADODB.Connection")
        mydbConnect.Open sConStr

    End Function

    Sub test()

        Dim con As Object, rs As Object
        Set con = mydbConnect()
        Set rs = con.Execute("SELECT CURRENT_TIMESTAMP")
        MsgBox rs.Fields(0), vbInformation, "Current Date/Time"

    End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...