Проблема обновления SQL Server с Excel 2016 на Workbook_Activate ()

Question

Я пытаюсь обновить SQL Server, используя Excel в Workbook_Activate (), который захватывает данные и отправляет ответ 1 в поле Grabbed после загрузки данных на лист. Похоже, код не выполняется.

Private Sub Workbook_Activate()

Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSql As String

Dim conn As New ADODB.Connection
Dim strConn As String
Dim PN As String
Dim partid As Integer

ActiveWorkbook.RefreshAll

strConn = "Driver={SQL Server};Server=servername; Database=CI; UID=userID; PWD=UserPassword"
cn.Open strConn

partid = Worksheets("Sheet3").Range("G2").Value

strSql = "UPDATE dbo.OHW_Schedule SET Grabbed = '1' WHERE ID = '" & partid & "' "

cn.Execute strSql

End Sub

когда я перебираю код за строкой, все работает нормально. Я пытался добавить DoEvents после обновления, но все равно не повезло. Я также пытался использовать Workbook_Open ()

Answer 1

Я часто обнаруживал, что вам нужно запускать соединения ADODB в отдельной процедуре, вызываемой через Application.OnTime Now(), "ProceedureName", чтобы Excel заканчивал открытие и выделение ссылок первым, а обновление происходит сразу после.

например:.

Option Explicit

Private Sub Workbook_Activate()
    Application.OnTime Now(), "ThisWorkbook.UpdateData"
End Sub

Private Sub UpdateData()
    Dim cn As ADODB.Connection, strSql As String
    Set cn = New ADODB.Connection

    Dim strConn As String, partid As Integer

    ThisWorkbook.RefreshAll 'Try to avoid ActiveWorkbook wherever possible!

    Application.StatusBar = "Connecting to DB"
    strConn = "Driver={SQL Server};Server=servername; Database=CI; UID=userID; PWD=UserPassword"
    cn.Open strConn

    partid = ThisWorkbook.Worksheets("Sheet3").Range("G2").Value 'Fully Qualify your Worksheets

    Application.StatusBar = "Running Update"
    strSql = "UPDATE dbo.OHW_Schedule SET Grabbed = '1' WHERE ID = '" & partid & "' "

    cn.Execute strSql

    Application.StatusBar = "Disconnecting from DB"
    cn.Close
    Set cn = Nothing
    Application.StatusBar = False
End Sub

Answer 2

Я знаю, что в другом ответе вы сказали, что пытались добавить пару секунд, я не был полностью уверен, что вы имели в виду, но я предполагаю, что вы уже пытались что-то подобное?

Измените 20 секунд на то, что вы когда-либо чувствуете

Private Sub workbook_activate()
Dim time_delay As Date
time_delay = Now() + TimeValue("00:00:20")
Application.OnTime time_delay, "thisworkbook.updatetable"
End Sub


Private Sub updatetable()

Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSql As String

Dim conn As New ADODB.Connection
Dim strConn As String
Dim PN As String
Dim partid As Integer

ActiveWorkbook.RefreshAll

strConn = "Driver={SQL Server};Server=servername; Database=CI; UID=userID; PWD=UserPassword"
cn.Open strConn

partid = Worksheets("Sheet3").Range("G2").Value

strSql = "UPDATE dbo.OHW_Schedule SET Grabbed = '1' WHERE ID = '" & partid & "' "

cn.Execute strSql

End Sub