I'm using ADO in VBScript. The query is simple and completes in a couple of seconds.
However, when I execute the GetString method, it takes a very long time to complete and sometimes never completes at all.
Set oShell = CreateObject( "WScript.Shell" )
user = oShell.ExpandEnvironmentStrings("%UserName%")
ConnectSqlServer "select top 100000 * from notices FOR JSON AUTO, INCLUDE_NULL_VALUES;", "PSQL003"
Sub ConnectSqlServer(query, database)
On Error Resume Next
sConnString = "Provider=SQLOLEDB.1;Data Source= " & database & "; " & _
"Initial Catalog=VIEW;" & _
"Integrated Security=SSPI;"
MakeConnectionString = "DSN=" & sDSN & ";Uid=" & sUid & ";Pwd=" & sPwd & ";"
Dim conn
Dim rs
Dim sConnString
Dim resultString
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
conn.Open sConnString
conn.CommandTimeout = 0
Set rs = conn.Execute(query)
Set Errs1 = conn.Errors
For Each errLoop In Errs1
With errLoop
StrTmp = StrTmp & "Error #" & i & ":"
StrTmp = StrTmp & vbCrLf & " ADO Error #" & .Number
StrTmp = StrTmp & vbCrLf & " Description " & .Description
StrTmp = StrTmp & vbCrLf & " Source " & .Source
i = i + 1
End With
Next
Msgbox "Query Finished"
resultString = rs.GetString
Msgbox "String Created"
End Sub
Related
I'm calling from VBA a stored procedure from a PC and it is working okay. In another PC and different user it is not working. A single query though, it is working in both PCs.
I'm calling the stored procedure as follows:
Dim rst As New ADODB.Recordset
Dim ConnectionString As String
Dim StrQuery As String
' Connection string for accessing MS SQL database
ConnectionString = <Connection details>
' Opens connection to the database
cnn.Open ConnectionString
' Timeout error in seconds for executing the entire query; The stored procedure normally runs for around 20 min
cnn.CommandTimeout = 2400
' Process execution
StrQuery = "exec [00_Main] #date = '01/31/2018' "
rst.Open StrQuery, cnn
rst.Close
I'm guessing that I have an error message when executing the stored procedure, but I don't know how to capture it.
I tried the following, but I don't get anything as an output
' Process execution
StrQuery = "exec [00_Main] #date = '01/31/2018' "
rst.Open StrQuery, cnn
Debug.Print rst.Fields.Count
Debug.Print rst.RecordCount
Debug.Print rst
rst.Close
When I run the stored procedure in SQL Management studio I just get output messages as the stored procedure just updates tables. Like:
(29145907 rows affected)
(330527 rows affected)
I tried also adding Error Information following link here, but the process runs without giving me any error. Like:
' Process execution
DateSelection = Sheets("STB Check").Range("F1")
'StrQuery = "exec [00_Main] #date = '" & DateSelection & "' "
StrQuery = "exec [00_Main] #date = '01/31/2018' "
rst.Open StrQuery, cnn
Done:
rst.Close
Exit Sub
AdoError:
Dim errLoop As Error
Dim strError As String
i = 1
' Process
StrTmp = StrTmp & vbCrLf & "VB Error # " & Str(Err.Number)
StrTmp = StrTmp & vbCrLf & " Generated by " & Err.Source
StrTmp = StrTmp & vbCrLf & " Description " & Err.Description
' Enumerate Errors collection and display properties of
' each Error object.
Set Errs1 = cnn.Errors
For Each errLoop In Errs1
With errLoop
StrTmp = StrTmp & vbCrLf & "Error #" & i & ":"
StrTmp = StrTmp & vbCrLf & " ADO Error #" & .Number
StrTmp = StrTmp & vbCrLf & " Description " & .Description
StrTmp = StrTmp & vbCrLf & " Source " & .Source
i = i + 1
End With
Next
MsgBox StrTmp
' Clean up Gracefully
On Error Resume Next
GoTo Done
Any ideas?
Use proper parameterization, and treat dates as Date, not as strings.
Instead of running that straight off ADODB.Recordset, use an ADODB.Command; set the command text to just the name of the stored procedure, and add an ADODB.Parameter to its Parameters collection, providing the cell value (after validating that IsDate returns True for that cell value) - like on learn.microsoft.com:
Dim theDate As Date
theDate = Sheets("STB Check").Range("F1").Value
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "[00_Main]"
Dim dateParam As ADODB.Parameter
Set dateParam = cmd.CreateParameter("date", adDate, adParamInput)
dateParam.Value = theDate
cmd.Parameters.Append dateParam
Dim results As ADODB.Recordset
Set results = cmd.Execute
Can someone please let me know what is wrong with this code? I have checked all lines for misspellings - this isnt the issue. All tables and queries are written as they exist in the db. Any help is appreciated.
Private Sub LoadArray()
'---------------------------
'---------------------------
'This procedure loads text into the 3rd column of the array
'---------------------------
'---------------------------
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsFiltered As DAO.Recordset
Dim strSQL As String
Dim i As Integer
strSQL = "SELECT tblProperties.Name, tbl1OpportuniyType.Type, qryPropertiesALLTypesALLTbls.TotalUnits, " _
& "qryPropertiesALLTypesALLTbls.EventStartTimeEachDay, qryPropertiesALLTypesALLTbls.EventEndTimeEachDay, " _
& "qryPropertiesALLTypesALLTbls.EventStartDate, qryPropertiesALLTypesALLTbls.EventStopDate, " _
& "qryPropertiesALLTypesALLTbls.TechOpsGroup, qryPropertiesALLTypesALLTbls.TechOpsResource " _
& "FROM tbl1OpportuniyType RIGHT JOIN (qryPropertiesALLTypesALLTbls INNER JOIN tblProperties ON qryPropertiesALLTypesALLTbls.[PropertyComplex_ID] = tblProperties.[PropertyComplex_ID]) ON tbl1OpportuniyType.[OpportunityType_ID] = tblProperties.OpportunityType " _
& "WHERE (((qryPropertiesALLTypesALLTbls.EventStartDate) Is Not Null));"
'Debug.Print strSQL
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
'This line ensures that the recordset is populated
If Not rs.BOF And Not rs.EOF Then
'Loops through the Array using dates for the filter
For i = LBound(myArray) To UBound(myArray)
If myArray(i, 1) Then
'Filters recordset with array dates
rs.Filter = "[EventStartDate]= " & myArray(i, 0)
'Open up new recordset based on filter
Set rsFiltered = rs.OpenRecordset
'Loop through new recordset
Do While (Not rsFiltered.EOF)
'Adds text to the 3rd column of the array
myArray(i, 2) = myArray(i, 2) & vbNewLine _
& rsFiltered!Type & " - " & vbNewLine _
& rsFiltered!Name & " " _
& rsFiltered!EventStartDate & " - " _
& rsFiltered!EventStopDate & " " _
& rsFiltered!EventStartTimeEachDay & " - " _
& rsFiltered!TechOpsGroup & " " _
& rsFiltered!TechOpsResource & " " _
& vbNewLine
rsFiltered.MoveNext
Loop
End If
Next i
End If
rsFiltered.Close
rs.Close
'Sets objects to nothing
Set rsFiltered = Nothing
Set rs = Nothing
Set db = Nothing
End Sub
It isn't clear where myArray comes from, but the filter needs an adjustment to convert the date value to a string expression:
rs.Filter = "[EventStartDate] = #" & Format(myArray(i, 0), "yyyy\/mm\/dd") & "#"
I am opening an SQL Server Connection in EXCEL VBA and on the objMyCmd.Execute line when it is using the SQL script I am getting this error message:
"Run-time error '-2147217900 (80040e14)') Automation error"
I have reviewed other SO posts that seem to reference an issue with the connection string itself, but I don't believe that is the issue as I am able to pull the first few variables listed when eliminating the rest of the SQL script.
I have attempted to review the SQL code to see if I am using an incorrect format, or if the language is not written properly and I am not able to determine the issue. I am hoping with some Q & A we may notice something I have missed in how this is written? Please let me know if there is additional information I can provide, below is the code up to the point of error.
Sub SQL_GetAgentChart()
Dim dtDate As Date
Dim myTable As ListObject
Dim DataServer As String
Dim Database As String
Dim constring As String
DataServer = "GLSSQLMADP2"
Database = "PERF_MGMT_BWRSRV_PROD"
constring = "Driver={SQL Server};Server=" & DataServer & "; Database=" & Database & "; Trusted_Connection=yes"
Dim AVStartDate As Date
Dim AVEndDate As Date
Dim RepID As Long
'Declare variables'
Set objMyConn = New ADODB.Connection
Set objMyCmd = New ADODB.Command
Set objMyRecordset = New ADODB.Recordset
Set myTable = Worksheets("Witness").ListObjects("tblWitness")
AVStartDate = DateValue("Mar 01, 2016")
AVEndDate = DateValue("Mar 31, 2016")
RepID = 2040
'Open Connection'
objMyConn.ConnectionString = constring
objMyConn.Open
'Set and Excecute SQL Command'
Set objMyCmd.ActiveConnection = objMyConn
objMyCmd.CommandText = " " & _
"SELECT PERSN_XTRNL_ID_NR, SOURCE, LOGGINGTS, DD7, CUREREASON, CUREDATE, LNSTATUS " & _
"FROM TTB " & _
"WITH INCALL AS (SELECT T.CUREREASON, CUREVALUE " & _
"FROM TTB T " & _
"JOIN PERSONNEL P ON T.PERSONNELID = P.PERSONNELID " & _
"LEFT JOIN CURETRANSLATE C ON T.CUREREASON = C.CUREREASON AND T.LNSTATUS = C.STATUS " & _
"WHERE T.PERSONNELID = " & RepID & " " & _
"AND LOGGINGTS > '" & AVStartDate & "' " & _
"AND LOGGINGTS < '" & AVEndDate + 1 & "' " & _
"AND INCOMING = 1 " & _
"AND DD7 > 0), OUTCALL AS (SELECT T.CUREREASON, CUREVALUE " & _
"FROM TTB T " & _
"JOIN AVAYA A ON T.UID = A.TTBUID " & _
"LEFT JOIN CURETRANSLATE C ON T.CUREREASON = C.CUREREASON AND T.LNSTATUS = C.STATUS " & _
"WHERE PERSONNELID = " & RepID & " " & _
"AND LOGGINGTS > '" & AVStartDate & "' " & _
"AND LOGGINGTS < '" & AVEndDate + 1 & "' " & _
"AND INCOMING = 0 " & _
"AND A.AVAYAGROUP IN ('15', '1A', '1B', '1C', '1D', '1E', '1F', '1G', '1H') " & _
"AND DD7 > 0) "
objMyCmd.CommandType = adCmdText
objMyCmd.Execute
We have a VBScript that downloads chunks of data from an SAP Business Object database into so-called slices, which are basically .csv files. The script worked perfectly so far, I haven't really had to look into it at all. But the failure now is this:
The script file section this error refers to is the dbConn.Execute(strSQL) line in the below code (5th from below).
What I tried so far, was to add these commands but they don't seem to solve anything:
'dbConn.ConnectionTimeout = 100
'dbConn.CommandTimeout = 100
The script itself (not all of it, I'm not sure the rest is needed):
Sub subRunFilesInFolder(strFolder)
Dim FSO, objFolder, objFiles
Dim i, intTS, intTS_file_start, ts, tsKillBefore, TS_file_start, strModelName
Dim dbConn, RST, RST2, strSQL
Dim strVBSmodel
Dim blRunIt
'INIs
strModelName = "bo_vbs_runner_1.5 "
strConn = "DRIVER={SQL Server};SERVER=EUBASEURCIREP01;UID=ser_login;PWD=ser_login;DATABASE=ser"
strComputer = FunstrComputerName
strBORunner = "\\Eubaseurcirep01\reporting\DEVELOPMENT\BO\Automation\Models\BO_auto_run.xlsb"
'Sets
Set dbConn = CreateObject("ADODB.Connection")
Set RST = CreateObject("ADODB.RecordSet")
Set RST2 = CreateObject("ADODB.RecordSet")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set FSO = Wscript.CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder(strFolder)
Set objFiles = objFolder.Files
Set appExcel = CreateObject("Excel.Application")
'dbConn.ConnectionTimeout = 100
'dbConn.CommandTimeout = 100
strVBSmodel = strModelName & strComputer & " " & FunstrUserName & " " & funCurrProcessId & " " & FunGetProcessIDCurrentOfExcel(strComputer)
appExcel.Application.Visible = False
appExcel.Displayalerts = False
Set objBORunner = appExcel.Workbooks.Open(strBORunner)
dbConn.Open strConn
ts = FunGetServerNow(dbConn,RST)
tsKillBefore = DateAdd("N", -15, ts)
intTS = funTimeStampToInteger(FunGetServerNow(dbConn, RST))
'Get ReportDate
strSQL = "SELECT yyyymmdd FROM map.reportdate WHERE dtAct=cast(GETDATE() as DATE);"
RST.Open strSQL, dbConn
If RST.EOF Then
strReportDate="99991231"
Else
strReportDate=RST.fields(0).value
End If
RST.close
'Kill stucked excel and vbs processes
strSQL = "SELECT distinct * FROM [ser].[bo].[_log] WHERE [proc]='BO VBS' AND result_text='started' AND end_timestamp<" & funTimeStampToInteger(tsKillBefore) & _
" AND lower(model) like '% " & LCase(strComputer) & " %';"
RST.Open strSQL,dbConn
If RST.EOF Then 'Nothing to kill
Else
Do While Not RST.EOF
strOldVBS = split(RST.fields("model"), " ")(3)
strOldExcel = split(RST.fields("model"), " ")(4)
Call SubKillProcessIDOnstrComputer(strComputer, strOldVBS)
Call SubKillProcessIDOnstrComputer(strComputer, strOldExcel)
strSQL = "UPDATE [ser].[bo].[_log] SET result_text='stopped', end_timestamp='" & funTimeStampToInteger(FunGetServerNow(dbConn,RST2)) & "' " & _
"WHERE [proc]='BO VBS' AND result_text='started' AND model='" & RST.fields("model").value & "' AND parameters='" & _
RST.fields("parameters").value & "';"
dbConn.Execute(strSQL)
RST.MoveNext
Loop
End If
RST.close
To Decode 0x8004nnnn Errors
HResults with facility code 4 means the HResult contains OLE errors (0x0 =
to 0x1ff) while the rest of the range (0x200 onwards) is component =
specific errors so 20e from one component will have a different meaning =
to 20e from another component.
You are lucky as your component is telling you it's OLDB with it's error - TIMEOUT
I'm really sorry to be asking and I'm sure it's extremely simple to answer but whenever I try to run the macro in excel below, I get the error message stated in the title:
Sub CallsMacro()
Dim ConData As ADODB.Connection
Dim rstData As ADODB.Recordset
Dim wsSheet As Worksheet
Dim strServer As String
Dim strDatabase As String
Dim strFrom As String
Dim strto As String
Dim intCount As Integer
Set wsSheet = ActiveWorkbook.Worksheets("Refresh")
With wsSheet
strServer = "TNS-CCR-02"
strDatabase = "AvayaSBCCRT"
strFrom = .Range("C$2")
strto = .Range("C$3")
End With
Set ConData = New ADODB.Connection
With ConData
.ConnectionString = "Provider=SQLOLEDB;Data Source=" & strServer & ";" & "Initial Catalog=" & ";" & "persist security info=true;" & "User Id=dashboard; Password=D4$hboard;"
.CommandTimeout = 1800
.Open
End With
''Create the recordset from the SQL query
Set rstData = New ADODB.Recordset
Set wsSheet = ActiveWorkbook.Worksheets("Calls")
With rstData
.ActiveConnection = ConData
.Source = "SELECT DISTINCT CAST(c.createdate AS date) as [Date]," & _
"CASE WHEN c.[CategoryID] = 1 then 'Outbound' WHEN c.[CategoryID] = 2 then 'Inbound' Else 'Internal' end as [Direction], c.cli as [Number], c.ddi, 'CallCentre' as [Queue], '' as [Queue Time], u.username as [Agent], cast((c.DestroyDate - c.CreateDate) as TIME) as [Duration], 'Connected' as [Status], c.callID as [Reference]" & _
"FROM [AvayaSBCCRT].[dbo].[tblAgentActivity] as a" & _
"JOIN [AvayaSBCCRT].[dbo].[tblCallList] as c on c.calllistid = a.calllistid" & _
"JOIN [AvayaSBCCRT].[dbo].[tblUsers] as u on u.userid = a.AgentID" & _
"WHERE c.createdate between '" & strFrom & "' and '" & strto & "'" & _
"AND a.[ActivityID] = 3 "
.CursorType = adOpenForwardOnly
.Open
End With
wsSheet.Activate
Dim Lastrow As Long
Lastrow = Range("A" & Rows.Count).end(xlUp).Row
Range("A2:J" & Lastrow).ClearContents
If rs.EOF = False Then wsSheet.Cells(2, 1).CopyFromRecordset rsData
rs.Close
Set rs = Nothing
Set cmd = Nothing
con.Close
Set con = Nothing
End Sub
I've looked high and low and cannot find the reason for it. Anybody have any ideas?
You're missing spaces from the end of the lines. Your SQL contains for example:
[tblAgentActivity] as aJOIN [AvayaSBCCRT].[dbo].[tblCallList]