asked on

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

Norie

Stevie

Why are you calling the sub Execute from itself?

Stevie Zakhour

ASKER

Hi Norie

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

Appreciate your help!

Norie

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.

Stevie Zakhour

ASKER

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!

Norie

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 Zakhour

ASKER

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

Norie

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 Zakhour

ASKER

Nice one, thank you. I will give this a try and will revert back.

Stevie Zakhour

ASKER

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:

Thanks again for your help, really appreciate it!

Norie

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 Zakhour

ASKER

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!

Norie

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 Zakhour

ASKER

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

SQL.pdf

Thanks Norie!

Norie

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 Zakhour

ASKER

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!

Norie

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 Zakhour

ASKER

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 Zakhour

ASKER

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?

ASKER CERTIFIED SOLUTION

Norie

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Stevie Zakhour

ASKER

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

Norie

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 Zakhour

ASKER

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 Zakhour

ASKER

Hi Norie

All working, thank you very much for your help and patience!!