PDA

View Full Version : Can not run SQL update statement



jsabo
08-22-2013, 01:59 PM
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
08-22-2013, 04:45 PM
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).