Excel VBA - Excel Shutsdown when running VBA

Hi All

Using Windows Excel 2016, I created the below VBA (I removed the IP Address, Database Name and Credentials for Security Reasons in the Public Const connStr)

Option Explicit

Public Const connStr = "Provider=SQLOLEDB.1;Data Source=IPAddress;Initial Catalog=Database;User ID=Username;Password=Password;Persist Security Info=True;"


Sub Execute()

    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim strSQL As String
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = connStr
    cn.Open
    
    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = cn
        .CommandText = "Siriusware_Report_Bookings&WhereHear"
        .CommandType = adCmdStoredProc
        .Parameters.Append cmd.CreateParameter("startdate", adDBDate, adParamInput, 50)
        .Parameters("startdate").Value = Sheets("Parameters").Range("Start_Date").Value
        .Parameters.Append cmd.CreateParameter("enddate", adDBDate, adParamInput, 50)
        .Parameters("enddate").Value = Sheets("Parameters").Range("End_Date").Value
        .Parameters.Append cmd.CreateParameter("facility", adVarChar, adParamInput, 10)
        .Parameters("facility").Value = Sheets("Parameters").Range("Facility").Value
    End With
    
    Call Execute
    Sheets("Output").Range ("A1")

    Set cmd = Nothing
    
    cn.Close
    
    
End Sub
'

Open in new window


When I run the VBA, Excel shutsdown unexpectedly, this is when I click the Run Report button I inserted into the Parameters tab and assigned the Macro called Execute with the variable fields having their boxes filled with the data I like to see come back. See Name Manager attachment.

In SQL, there is a Stored Procedure called Siriusware_Report_Bookings&WhereHear which I can run by running the query below. This returns the desired results.

exec [dbo].[Siriusware_Report_Bookings&WhereHear] '2018-01-01 00:00:00', '2018-01-02 11:59:59', 'pen'

Open in new window


There are 3 variables in the Stored Procedure Siriusware_Report_Bookings&WhereHear, there are

@startdate as datetime, @enddate as datetime, @facility as varchar(5)

Open in new window


Your help is greatly appreciated!
Name-Manager-.pdf
Stevie ZakhourAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant Commented:
Stevie

Why are you calling the sub Execute from itself?
Stevie ZakhourAuthor Commented:
Hi Norie

How should I be calling it? Can you give me an example?

Appreciate your help!
NorieAnalyst Assistant Commented:
Stevie

Assuming this code is in a standard module in VBA I would have assigned the sub Execute to a button, e.g. your Run Report button, and I would remove this line.
 Call Execute

Open in new window


Mind you there does appear to be something missing from the code.

For example, there doesn't appear to be any code that actually executes the ADODB command.
The 7 Worst Nightmares of a Sysadmin

Fear not! To defend your business’ IT systems we’re going to shine a light on the seven most sinister terrors that haunt sysadmins. That way you can be sure there’s nothing in your stack waiting to go bump in the night.

Stevie ZakhourAuthor Commented:
Thanks Norie, that's helpful.

I have removed the line below

 Call Execute

Open in new window


The Run Report button has is assigned to the macro Execute. But when I run the VBA via the Report Button, I get the below message

Run-time error '438': Object doesn't support this property or method

When I hit the debug button, the debugger highlights the below

Sheets("Output").Range ("A1")

Open in new window


Just a little confused as to why this is. Thanks again for your help!
NorieAnalyst Assistant Commented:
What are you trying to do with that line of code?

Is it meant to return a result from the execution of the stored procedure?
Stevie ZakhourAuthor Commented:
Correct.

I'd need to get the result of the query into the Output tab. Let me know what other information you need.

Thanks again
NorieAnalyst Assistant Commented:
Stevie

You need to execute the ADODB command, return the results to the ADODB recordset and then output them to the sheet

I'm a bit rusty with ADODB and not at a computer but try this.
Set rs = cmd.Execute

Sheets("Output").Range("A1").CopyFromRecordset rs

Open in new window

Stevie ZakhourAuthor Commented:
Nice one, thank you. I will give this a try and will revert back.
Stevie ZakhourAuthor Commented:
Hi Norte

Thanks again for your help, I added the two lines

Set rs = cmd.Execute

Sheets("Output").Range("A1").CopyFromRecordset rs

Open in new window


The result after hitting the Run Report button outputs an error message, the message sahs

Run-time error ‘-2147217900 (80040e14)’: Syntax error or access violation

The debugger points to the below in the VBA code

Set rs = cmd.Execute

Open in new window


I have attached the debugger (see attached file called Debugger) where it highlights the above.

Or see embedded:

Debugger

Thanks again for your help, really appreciate it!
NorieAnalyst Assistant Commented:
Stevie

Does it work if you hard code the query?
 With cmd
        .ActiveConnection = cn
        .CommandText = "exec [dbo].[Siriusware_Report_Bookings&WhereHear] '2018-01-01 00:00:00', '2018-01-02 11:59:59', 'pen'"
        .CommandType = adCmdStoredProc        
 End With

Open in new window

Stevie ZakhourAuthor Commented:
Sorry, it won't run, it throws an error, see below

Run-time error '-2147217900 (80040e14)': Syntax error or access violation

Debugger, the line item below is highlighted

Set rs = cmd.Execute

Open in new window


The VBA is below with the query you provided

Sub Execute()

    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim strSQL As String
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = connStr
    cn.Open
    
    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = cn
        .CommandText = "exec [dbo].[Siriusware_Report_Bookings&WhereHear] '2018-01-01 00:00:00', '2018-01-02 11:59:59', 'pen'"
        .CommandType = adCmdStoredProc
    End With
    
    Set rs = cmd.Execute

    Sheets("Output").Range("A1").CopyFromRecordset rs
    
    Set cmd = Nothing
    
    cn.Close
    
    
End Sub
'

Open in new window


Thanks again Norie!
NorieAnalyst Assistant Commented:
Stevie

You can definitely execute this in the database manually?
exec [dbo].[Siriusware_Report_Bookings&WhereHear] '2018-01-01 00:00:00', '2018-01-02 11:59:59', 'pen'

Open in new window

Stevie ZakhourAuthor Commented:
Correct. Below is the output in MS SQL (or see attached file called SQL)

SQL.pdf

Thanks Norie!
NorieAnalyst Assistant Commented:
Stevie

This might be a long shot but it's all I've got to go on right now, what happens if you replace the & in the name of the stored procedure with an underscore, or even remove it overall?
Stevie ZakhourAuthor Commented:
Thanks Norie, doing that now throws this message

Compile error: Constant expression required

Sub Execute()

    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.RecordSet
    Dim strSQL As String
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = connStr
    cn.Open
    
    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = cn
        .CommandText = "Siriusware_Report_BookingsWhereHear"
        .CommandType = adCmdStoredProc
        .Parameters.Append cmd.CreateParameter("startdate", adDBDate, adParamInput, 50)
        .Parameters("startdate").Value = Sheets("Parameters").Range("Start_Date").Value
        .Parameters.Append cmd.CreateParameter("enddate", adDBDate, adParamInput, 50)
        .Parameters("enddate").Value = Sheets("Parameters").Range("End_Date").Value
        .Parameters.Append cmd.CreateParameter("facility", adVarChar, adParamInput, 10)
        .Parameters("facility").Value = Sheets("Parameters").Range("Facility").Value
    End With
    
    Set rs = cmd.Execute

    Sheets("Output").Range("A1").CopyFromRecordset rs

    Set cmd = Nothing
    
    cn.Close
    
    
End Sub
'

Open in new window


I did update the Stored Proc name in the database and was able to run the SP using the query:

exec [dbo].[Siriusware_Report_BookingsWhereHear] '2018-01-01 00:00:00', '2018-01-02 11:59:59', 'pen'

Open in new window


Although I think we are getting close, thanks again for your help!
NorieAnalyst Assistant Commented:
Where do you get the error now?

PS Probably should have said earlier, but it would be a good idea to rename the sub - perhaps you could call it RunReport?
Stevie ZakhourAuthor Commented:
The debugger highlighted the below

Set rs = cmd.Execute

Open in new window


OK, I renamed the sub to RunReport, see below

Sub RunReport()

    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.RecordSet
    Dim strSQL As String
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = connStr
    cn.Open
    
    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = cn
        .CommandText = "Siriusware_Report_BookingsWhereHear"
        .CommandType = adCmdStoredProc
        .Parameters.Append cmd.CreateParameter("startdate", adDBDate, adParamInput, 50)
        .Parameters("startdate").Value = Sheets("Parameters").Range("Start_Date").Value
        .Parameters.Append cmd.CreateParameter("enddate", adDBDate, adParamInput, 50)
        .Parameters("enddate").Value = Sheets("Parameters").Range("End_Date").Value
        .Parameters.Append cmd.CreateParameter("facility", adVarChar, adParamInput, 10)
        .Parameters("facility").Value = Sheets("Parameters").Range("Facility").Value
    End With
    
    Set rs = cmd.Execute

    Sheets("Output").Range("A1").CopyFromRecordset rs

    Set cmd = Nothing
    
    cn.Close
    
    
End Sub
'

Open in new window


Now when I rerun the VBA it throws a new error, this error is

Run-time error '-2147217871 (80040e31)': Query timeout expired

The debugger highlights the below

Set rs = cmd.Execute

Open in new window


Thanks again Norie!
Stevie ZakhourAuthor Commented:
Hi Norie

I figured I'd rebuild the VBA, see below

Option Explicit

Public Const connStr = "Provider=SQLOLEDB.1;Data Source=IP;Initial Catalog=Database;User ID=User;Password=Password;Persist Security Info=True;"

Sub RunReport()
    
    Sheets("Output").Activate
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("A1").Select
    
    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.RecordSet
    Dim strSQL As String
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = connStr
    cn.Open
    
    
    Set cmd = New ADODB.Command

    With cmd
            .ActiveConnection = cn
            .CommandText = "Siriusware_Report_BookingsWhereHear"
            .CommandType = adCmdStoredProc
            .Parameters.Append cmd.CreateParameter("startdate", adDBDate, adParamInput, 50)
            .Parameters("startdate").Value = Sheets("Parameters").Range("Start_Date").Value
            .Parameters.Append cmd.CreateParameter("enddate", adDBDate, adParamInput, 50)
            .Parameters("enddate").Value = Sheets("Parameters").Range("End_Date").Value
            .Parameters.Append cmd.CreateParameter("facility", adVarChar, adParamInput, 10)
            .Parameters("facility").Value = Sheets("Parameters").Range("Facility").Value
             .CommandTimeout = 120
            .Execute
        End With
    
    Set rs = cmd.Execute()
    
    Sheets("Output").Range("A1").CopyFromRecordset rs
    
    Sheets("Output").Range("A1").Select
    
    rs.Close
    Set cmd = Nothing
    
    cn.Close
    
    
End Sub

Open in new window


When I run the VBA, it throws

Run-time error '-2147217871 (80040e31)': Query timeout expired

In the VBA, I added the
.CommandTimeout = 120

Open in new window

but this still does not work as expected. What are your thoughts here?
NorieAnalyst Assistant Commented:
For one thing, you shouldn't be executing the command twice.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Stevie ZakhourAuthor Commented:
Sorry mate, are you saying to comment out the
.Execute

Open in new window

from line 37 in my last post? If I do that I still get the
Query timeout expired

Thanks again for your help
NorieAnalyst Assistant Commented:
Yes, you should only need to execute the command once and I can't see executing it more than once causing helping.

As for the timeout, that could be a server/connection issue or perhaps something to do with the procedure you are trying to execute.

Have you tried executing the exact command you are trying to execute manually?

i.e. run this but replace the parameter values with the values from the cells.

exec [dbo].[Siriusware_Report_BookingsWhereHear] '2018-01-01 00:00:00', '2018-01-02 11:59:59', 'pen'
Stevie ZakhourAuthor Commented:
Hi Norie

Well, this happened. It worked! The below is the VBA that worked as expected

Option Explicit

Public Const connStr = "Provider=SQLOLEDB.1;Data Source=IP;Initial Catalog=DB;User ID=User;Password=Password;Persist Security Info=True;"
Sub RunReport()
    
    Sheets("Output").Activate
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("A1").Select
    
    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.RecordSet
    Dim strSQL As String
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = connStr
    cn.Open
    
    
    Set cmd = New ADODB.Command

    With cmd
            .ActiveConnection = cn
            .CommandText = "Siriusware_Report_BookingsWhereHear"
            .CommandType = adCmdStoredProc
            .Parameters.Append cmd.CreateParameter("startdate", adDBDate, adParamInput, 120)
            .Parameters("startdate").Value = Sheets("Parameters").Range("Start_Date").Value
            .Parameters.Append cmd.CreateParameter("enddate", adDBDate, adParamInput, 120)
            .Parameters("enddate").Value = Sheets("Parameters").Range("End_Date").Value
            .Parameters.Append cmd.CreateParameter("facility", adVarChar, adParamInput, 120)
            .Parameters("facility").Value = Sheets("Parameters").Range("Facility").Value
            ' .Execute
            .CommandTimeout = 120
        End With
        
    Set rs = cmd.Execute()
    
    Sheets("Output").Range("A1").CopyFromRecordset rs
    
    ' Sheets("Output").Range("A2").Select
    
    rs.Close
    Set cmd = Nothing
    
    cn.Close
    
    
End Sub

Open in new window


I'm going to test it again, stand-by.
Stevie ZakhourAuthor Commented:
Hi Norie

All working, thank you very much for your help and patience!!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Databases

From novice to tech pro — start learning today.