Can not run SQL update statement

[jsabo]

Hello,

I am very near finishing the script below. toward the bottom in a loop, i have "DoCmd.RunSQL SQL_String" but when it gets to this point, i get an error message stating, "Run-time error '2046': The command or action 'RunSQL' isn't available now."

Any ideas? the only spot i see myself disconnecting from the database is the condition endnow statement, unless im missing something:

Sub ActivityLogger()
'
' ActivityLogger Macro
'
' Keyboard Shortcut: Ctrl+Shift+A
'
Dim k As Integer
Dim cnt As Integer
Dim ws As Worksheet
Dim MyRange As Range, DelRange As Range, C As Range, cell As Range
Dim Cll As Excel.Range
Dim MatchString As String, SearchColumn As String, ActiveColumn As String
Dim FirstAddress As String, NullCheck As String
Dim AC
Dim LastRow As Long
Dim SQL_String As String
Dim dbConnectStr As String
Dim con As ADODB.Connection
Dim msg1 As String
Dim i As Integer
Dim recset As ADODB.RecordSet
Dim Col As Integer, Row As Long, s As String
Set con = New ADODB.Connection
Set recset = New ADODB.RecordSet
Dim recordCount As Long
dbConnectStr = "Provider=msdaora;User ID=;Password=;Data Source=" & ";"


Application.ScreenUpdating = False




con.ConnectionString = dbConnectStr
'con.Properties("Prompt") = adPromptAlways
con.Open dbConnectStr 'ConnectionString


'   Record locking
  recset.CursorType = adOpenKeyset
  recset.LockType = adLockOptimistic
    
    With recset




'SQL Query to retrieve stale dates


SQL_String = "SELECT DISTINCT busr_id,"
                    SQL_String = SQL_String & " alog_seqno,"
                    SQL_String = SQL_String & " busr_email,"
                    SQL_String = SQL_String & " SYSDATE,"
                    SQL_String = SQL_String & " po_number,"
                    SQL_String = SQL_String & " po_desc,"
                    SQL_String = SQL_String & " 'PO',"
                    SQL_String = SQL_String & " po_seqno,"
                    SQL_String = SQL_String & " po_revno,"
                    SQL_String = SQL_String & " alog_keylabel,"
                    SQL_String = SQL_String & " alog_desc,"
                    SQL_String = SQL_String & " alog_schedule_date,"
                    SQL_String = SQL_String & " alog_forecast_date,"
                    SQL_String = SQL_String & " alog_actual_date,"
                    SQL_String = SQL_String & " busr_firstname,"
                    SQL_String = SQL_String & " busr_lastname,"
                    SQL_String = SQL_String & " po_release_number"
      SQL_String = SQL_String & " FROM bps_users,"
           SQL_String = SQL_String & " po_personnel_assigns,"
           SQL_String = SQL_String & " po_headers,"
           SQL_String = SQL_String & " activities,"
           SQL_String = SQL_String & " milestones"
     SQL_String = SQL_String & " WHERE po_alog_seqno_next = alog_seqno"
           SQL_String = SQL_String & " AND alog_forecast_date < TRUNC (SYSDATE)"
           SQL_String = SQL_String & " AND NVL (po_sentexpedition, 0) = 0"
           SQL_String = SQL_String & " AND alog_actual_date IS NULL"
           SQL_String = SQL_String & " AND po_complete_cancelflag NOT IN ('C', 'X', 'D')"
           SQL_String = SQL_String & " AND po_seqno = popa_po_seqno"
           SQL_String = SQL_String & " AND mstn_value = alog_keylabel"
           SQL_String = SQL_String & " AND popa_relationship ="
                  SQL_String = SQL_String & " Case mstn_category"
                     SQL_String = SQL_String & " WHEN 'Purchasing' THEN 'BUYER'"
                     SQL_String = SQL_String & " WHEN 'Expediting' THEN 'EXPEDITOR'"
                     SQL_String = SQL_String & " WHEN 'Engineering' THEN 'REQUESTOR'"
                     SQL_String = SQL_String & " Else 'BUYER'"
                  SQL_String = SQL_String & " End"
           SQL_String = SQL_String & " AND popa_busr_id = busr_id"




        recset.Open Source:=SQL_String, ActiveConnection:=con


'       Write the field names
        For Col = 0 To .Fields.Count - 1
           Range("A1").Offset(0, Col).Value = recset.Fields(Col).Name
        Next Col
        
'       Write the recordset
        Range("A1").Offset(1, 0).CopyFromRecordset recset
        Dim a As Variant
        .MoveFirst
        'a = recset.GetRows
        'MsgBox LBound(a), , UBound(a)
        'MsgBox a(0), , a(1)


        If .recordCount < 1 Then GoTo endnow
        .MoveFirst
        For Row = 0 To (.recordCount - 1)
          'Debug.Print CStr(.Fields(Row).Value)
          .MoveNext
        Next Row
  End With
  
endnow:
    Set recset = Nothing
    con.Close
    Set con = Nothing
    
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select




    AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
    ActiveColumn = AC(0)
     
     
    On Error Resume Next
    LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set MyRange = ActiveSheet.Range("A2:A" & LastRow)
    On Error GoTo 0


    
'begin filter by BUN
    If MyRange Is Nothing Then Exit Sub
     
    MatchString = VBA.Environ("username")
     
    For Each Cll In MyRange.Cells
        If InStr(1, Cll.Value, MatchString, vbTextCompare) = 0 Then
            If DelRange Is Nothing Then Set DelRange = Cll Else Set DelRange = Union(DelRange, Cll)
        End If
    Next Cll


    If Not DelRange Is Nothing Then DelRange.EntireRow.Delete


'Indicate the number of stale dates
    ActiveSheet.Range("T2").FormulaR1C1 = "=COUNTIF(C[-19],RC[-19])"
    


'determine whether there are stale dates
    LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If LastRow < 2 Then
        MsgBox "You have no overdue PO Milestone Dates."
        ActiveWorkbook.Close False
    Else
        MsgBox "You have " & ActiveSheet.Range("T2").Value & " overdue PO Milestone Date(s). Let's correct them."
    End If
    
    ActiveSheet.Range("R2").FormulaR1C1 = _
        "=""The "" & RC[-7] & "" milestone for "" & RC[-13] & "" is stale. Has this task been completed?"""
    LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If LastRow > 2 Then Range("R2:R" & LastRow).FillDown
    
    ActiveSheet.Range("S2").FormulaR1C1 = "=RC[-14] & "" - "" & RC[-8]"
    LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If LastRow > 2 Then Range("S2:S" & LastRow).FillDown
    
ActiveSheet.UsedRange.Borders.Value = 1


'Change date format
Range("D:D,L:L,M:M,N:N").Select
selection.NumberFormat = "mm-dd-yyyy;@"


'begin loop of user input
For i = 2 To LastRow


    ActiveSheet.Range("R" & i).Select
        
        msg1 = MsgBox(ActiveCell.Value, vbYesNo, "Task Completed?")
    
    If msg1 = vbYes Then
        ActiveSheet.Range("N" & i).Select
        Actualized (i)
        
            SQL_String = "UPDATE activities "
            SQL_String = SQL_String & " SET ALOG_ACTUAL_DATE = TO_DATE('" & VBA.Format(ActiveSheet.Range("N" & i).Value, "mm-dd-yyyy") & "', 'mm-dd-yyyy') "
            SQL_String = SQL_String & " WHERE ALOG_SEQNO = " & ActiveSheet.Range("B" & i)


                 DoCmd.RunSQL SQL_String
                
    Else
        ActiveSheet.Range("M" & i).Select
        NotActualized (i)
        
            SQL_String = "UPDATE activities "
            SQL_String = SQL_String & " SET ALOG_FORECAST_DATE = TO_DATE('" & VBA.Format(ActiveSheet.Range("M" & i).Value, "mm-dd-yyyy") & "', 'mm-dd-yyyy') "
            SQL_String = SQL_String & " WHERE ALOG_SEQNO = " & ActiveSheet.Range("B" & i)
                
                 DoCmd.RunSQL SQL_String

    End If
    
Next i






End Sub

[jsabo]

Nevermind, got it working. Turns out, i was closing the connection at con.Close.


Then, instead of DoCmd.RunSQL SQL_String , used con.Execute (SQL_String).