vendredi 17 juin 2016

SQL Code and VBA

I have used this site before (and various others) and subsequently I have built something that usually works. It now isnt working with a new SQL script (but the SQL script does work!). Please note I am not good with VBA code and dont really understand it....!!!

Can someone help please? I get the error "Run-time error '3704' , Operation isnot allowed when the object is close"). I dont understand how it has closed before finishing!

I have two sections to this: Module 1 - contains the connection properties Module 2 - contains the SQL code to run Both below:

Module 1:

Public Const DBName As String =
Public Const strServer As String = "RMSSQL"
Public Const connecString1 As String = "Provider=SQLOLEDB.1"
Public Const connecString2 As String = ";Initial Catalog="
Public Const connecString3 As String = ";DataSource="
Public passSQL As ADODB.Connection
Public myrst As ADODB.Recordset

Public Function runTheQuery(sqlQuery, DBaseName)
    'connect
    Dim strConnect As String
    strConnect = "Driver={SQL Server}; Server=" & strServer & ";Database=" & DBaseName & ";Trusted_Connection=yes; "

    Set passSQL = New ADODB.Connection
    passSQL.ConnectionString = strConnect
    passSQL.CursorLocation = adUseClient
    passSQL.CommandTimeout = 0
    passSQL.Open

    'create recordset
    Dim aRst As ADODB.Recordset
    Set aRst = New ADODB.Recordset
    With aRst
    .activeconnection = passSQL
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockBatchOptimistic

    'run sql query
    .Open sqlQuery
    .activeconnection = Nothing

    End With
    Set myrst = aRst

    'close
    passSQL.Close
End Function    

Module 2:

Sub simplequery()
    runTheQuery "declare @Portname varchar(60) " & _
            "set @Portname = " & "'" & Range("G10").Value & "'" & _
            "SELECT SUM(M.TIV) as TIV " & _
            "FROM (select port.PORTNAME,  lcvg.LOCID, lcvg.LOSSTYPE, prop.OCCSCHEME, prop.OCCTYPE, MAX(lcvg.VALUEAMT) TIV " & _
            "from accgrp ac " & _
    "inner join Property prop on prop.ACCGRPID = ac.ACCGRPID " & _
    "inner join Address addr on addr.AddressID = prop.AddressID " & _
    "inner join loccvg lcvg on lcvg.LOCID = prop.LOCID " & _
    "inner join portacct pa on pa.ACCGRPID = ac.ACCGRPID " & _
    "inner join portinfo port on port.PORTINFOID = pa.PORTINFOID " & _
    "where port.PORTNAME = @Portname " & _
    "group by port.PORTNAME,  lcvg.LOCID, lcvg.LOSSTYPE, prop.OCCSCHEME, prop.OCCTYPE, lcvg.VALUEAMT) M " & _
    "GROUP BY M.PORTNAME; ", Sheets("Modelled Results - 1 of 2").Range("g9").Value

    Sheets("DataDumps").Range("A1").Select

    'Headers
    For col = 0 To myrst.Fields.Count - 1
        ActiveCell.Offset(0, col).Value = myrst.Fields(col).Name
    Next

    'Paste recordset
    Range("A1").CopyFromRecordset myrst
End Sub 

When I debug, it is this that is highlighted:

'Paste recordset
Range("A1").CopyFromRecordset myrst

Aucun commentaire:

Enregistrer un commentaire