SQL代碼和VBA

Question

我已經使用過這個網站之前（和其他各種），隨後我建立了一些通常有效的東西。它現在還沒有使用新的SQL腳本（但SQL腳本確實可行！）。請注意我對VBA代碼不太好，並不真正瞭解它。

有人可以幫忙嗎？我收到錯誤「運行時錯誤'3704'，當對象關閉時不允許操作」）。 我不明白在完成之前它是如何關閉的！

我有兩個部分，以這樣的： 模塊1 - 包含連接屬性 模塊2 - 包含SQL代碼 都低於運行：

模塊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這樣runTheQuery "SELECT...", "MyDb", Range("A1")。

Soultion 2

歇runTheQuery成若干個功能：

1. OpenRecordset
2. RunQuery
3. CloseRecordset

你會打電話OpenRecordset第一。根據需要撥打RunQuery。如果不再需要內容，最後致電CloseRecordset。

EDIT

新增工作示例中，按照OP請求。

以下是我的代碼版本。我刪除了一些我覺得沒有添加任何值的行。但是如果你覺得不同，你可以重新加入他們（一切都應該正常工作或不工作）。我也改變了function to a sub，因爲它不會返回任何東西。再次，這不會改變代碼的工作方式，它只是更加整潔。

因爲它代表這個代碼是好的，但可能會更好。我在幾年前閱讀過，任何VBA比一個屏幕更長的時間過長。我一直認爲這是一個有用的規則。小的子/ funcs更容易閱讀，理解和debug，即使你最終得到更多。當你對VBA更有信心時，看看你是否將它分成幾個邏輯步驟，或許是從另一個子序列中依次調用。這樣可以更輕鬆地打開和關閉功能（例如，您可能不總是需要標題行）。最後，我添加了可選語句Option Explicit。這可以防止您的代碼調用尚未聲明的變量。總是很好的做法。

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 

要調用這個代碼：

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 

正如你可以看到這個子沒有做非常多了。所有的工作已被轉移到runTheQuery。