SQLコードとVBA

Question

私は以前にこのサイトを使用していましたが、その後は通常動作するものを構築しました。新しいSQLスクリプトでは動作しません（ただし、SQLスクリプトは機能します）。私はVBAコードではうまくいかず、本当にそれを理解していません.... !!!

誰か助けてもらえますか？私はエラー "実行時エラー '3704'、操作is notオブジェクトが閉じるときに許可されていません"）。 仕上げの前にどのように閉じているのかわかりません！

私はこれには2つのセクションがあります。 モジュール1 - 下の両方 を実行するために、SQLコードが含まれている - 接続プロパティ モジュール2含まれています

モジュール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  

をモジュール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 

私はデバッグする場合、それが強調表示され、このです：このように更新

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

：

モジュール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 

Function runTheQuery(ByVal SQLQuery As String, ByVal DBName As String, ByRef MyRange As Range) 

'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 

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 

MyRange.CopyFromRecordset myrst 
myrst.Close 

End Function 

モジュール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, Range("a1") 

End Sub 

Answer 1

モジュール1の下部で接続を閉じました。レコードセットを使用するには、接続を開いたままにする必要があります。

Answer 2

ここでの問題は、runTheQueryが最後のアクションとしてレコードセットをクローズすることです。閉じたレコードセットからレコードをインポートすることはできません。これを解決するにはいくつかの方法があります。

溶液1

runTheQueryの範囲のオブジェクトを渡し、そこにペーストを実行します。

Function runTheQuery (ByVal SQLQuery AS String, ByVal DBName AS String, ByRef MyRange AS Range) 

    ' Code as before. 

    ' New code at end of function. 
    MyRange.CopyFromRecordset myrst 
    myrst.Close 
End Function 

あなたは今、このようなrunTheQuery "SELECT...", "MyDb", Range("A1")runTheQueryを呼び出します。

Soultion 2

ブレークrunTheQueryは、多くの機能へ：

1. のOpenRecordset
2. によってRunQuery
3. CloseRecordset

最初OpenRecordsetを呼び出します。必要に応じてRunQueryに電話してください。最後に、コンテンツが不要になったらCloseRecordsetに電話してください。

EDIT

はOPの要求ごととして、実施例を追加しました。

以下は私のコードです。私は、何の価値も加えていないと感じた数行を削除しました。しかし、あなたが違って感じるならば、それらを戻すことができます（すべてがうまくいくかどうかは問題ありません）。 function to a subも変更されました。何も返されません。ここでもコードがどのように動作するかは変わりません。

このコードは大丈夫ですが、改善する可能性があります。私は何年も前に、1つの画面よりも長いVBA手順は長すぎると読んでいます。私はいつもそれが有用なルールであることを発見しました。より小さいサブ/機能は読みやすく、理解しやすく、debug、それ以上のもので終わったとしても。 VBAに自信を持っていくにつれて、これをいくつかの論理的なステップに分割したかどうかを確認してください。おそらくすべてが別のサブから順番に呼び出されます。これにより、機能をオンまたはオフにすることが容易になります（たとえば、ヘッダー行が常に必要な場合など）。最後に、オプションの文Option Explicitを追加しました。これにより、宣言されていない変数をコードから呼び出すことができなくなります。常に良い練習。あなたはもうあまりをしないこのサブを見ることができるように

Sub simplequery() 
' Imports the results of a SQL query. 
Dim DbName As String 

    ' Get the database name. 
    DbName = Sheets("Modelled Results - 1 of 2").Range("g9").Value 

    ' Import query. 
    runTheQuery "<Your SQL Query Here>", DbName, Sheets("DataDumps").Range("A1") 
End Sub 

：

Option Explicit 
Public Const strServer As String = "RMSSQL"  ' Name of SQL Server to connect to. 

Public Sub runTheQuery(ByVal SQLQuery As String, ByVal DBName As String, ByRef MyRange As Range) 
' Copies a SQL result set into an Excel workbook. 
' SQLQuery - Valid SQL statement to be executed. 
' DBName  - Name of database to execute SQL query on. 
' MyRange  - Top left cell to paste results into. 

Dim passSQL As ADODB.Connection ' Connection to SQL Server. 
Dim myrst As ADODB.Recordset ' Used to execute query and hold results. 
Dim col As ADODB.Field   ' Used to import header row. 
Dim i As Integer    ' Used to count fields, when importing header. 


    ' Ready objects for use. 
    Set passSQL = New ADODB.Connection 
    Set myrst = New ADODB.Recordset 

    ' Connect to SQL Server. 
    With passSQL 
     .ConnectionString = "Driver={SQL Server}; Server=" & strServer & ";Database=" & DBName & ";Trusted_Connection=yes;" 
     .CommandTimeout = 0  ' Prevents large queries from timing out. Perhaps not needed? 
     .Open 
    End With 

    ' Execute query. 
    With myrst 
     .ActiveConnection = passSQL 
     .Open SQLQuery 
    End With 


    ' Import results, if there are any. 
    If Not myrst.EOF Then 

     ' Import header into first row. 
     ' Count fields to offset from top left cell, across one. 
     For Each col In myrst.Fields 

      MyRange.Offset(0, i).Value = col.Name 
      i = i + 1 
     Next 

     MyRange.Offset(1, 0).CopyFromRecordset myrst ' Paste results after header (offset). 
    Else 

     MsgBox "The query did not return any records", vbExclamation, "Query Warning" 
    End If 


    ' Close and release object vairables before they leave scope. 
    ' You must close the recordset first, as it replies on an open connection. 
    myrst.Close 
    passSQL.Close 

    Set myrst = Nothing 
    Set passSQL = Nothing 
End Sub 

は、このコードを呼び出します。すべての作品は runTheQueryに移されました。