SSMS 2014 を呼び出してクエリを実行し、ワークシートの定義済みセルに結果を返すマクロがいくつかあります。それらは正常に機能しますが、一時テーブルで特定のクエリを使用しようとすると、次のエラー メッセージが表示されます。
私はオンラインで調査しましたが、見つけることができる最良の答えSET NOCOUNT ON
は、クエリの先頭に追加することです。私はそれを試しましたが、それでも同じメッセージが表示されました。
が私を連れてくるコードDebug
は次のとおりです。
bqr.Range("B6").CopyFromRecordset rst
私のコードの要点と、重要な変数の設定は次のとおりです。
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim ConnectionString As String
Dim StrQuery As String
Dim SOURCE As String
Dim DATABASE As String
Dim QUERY As String
Dim intColIndex As Integer
Dim sDate As String
Dim eDate As String
Dim qt As Worksheet
Dim qtr As Worksheet
Dim bqr As Worksheet
Dim bp As Worksheet
ConnectionString = "Provider=SQLOLEDB;Data Source=" & SOURCE & "; Initial Catalog=" & DATABASE & "; Integrated Security=SSPI;"
cnn.Open ConnectionString
cnn.CommandTimeout = 900
StrQuery = QUERY
rst.Open StrQuery, cnn
bqr.Range("B6").CopyFromRecordset rst
For intColIndex = 0 To rst.Fields.Count - 1
Range("B5").Offset(0, intColIndex).Value = rst.Fields(intColIndex).Name
Next
最も紛らわしいのは、rst
レコードセットを使用する直前に開いているにもかかわらず、エラーがレコードセットが閉じていることを示していることです。CopyFromRecordset
DROP TABLE
クエリの最後に関数を追加してみましたSET NOCOUNT ON
。また、いくつかの小さな単純な一時テーブルをテストとしてテストしました。
たとえば、QUERY
変数を次のように設定します。
QUERY = "CREATE TABLE #Test1 (TestID INT, TestValue VARCHAR(20))"
QUERY = QUERY + " INSERT INTO #Test1"
QUERY = QUERY + " VALUES (1, 'Pass'), (2, 'Fail'), (3, 'Try Again')"
QUERY = QUERY + " SELECT * INTO #Test2 FROM #Test1 WHERE TestID = 1"
QUERY = QUERY + " SELECT * FROM #Test2"
次に、コードを実行して抽出し、Excel に貼り付けたところ、機能しました。
したがって、私は困惑しています。クエリの長さに制限があるのではないでしょうか? 今は180行あるからかなり大きい…
どんな提案でも大歓迎です!
編集: 以下の完全なマクロ (実際のクエリを除く):
Private Sub CommandButton1_Click()
If TextBox1.Value = "i.e. 20160101" Or TextBox2.Value = "i.e. 20160131" Then
MsgBox "Please fill out all fields before proceeding"
ElseIf Len(TextBox1.Value) <> 8 Or Len(TextBox2.Value) <> 8 Or Not IsNumeric(TextBox1.Value) Or Not IsNumeric(TextBox2.Value) Then
MsgBox "Please use correctly formatted Datekeys (i.e. yyyymmdd)"
Else
Application.DisplayAlerts = False
Sheets(ActiveWorkbook.Sheets.Count).Select
While ActiveSheet.Name <> "[worksheet I want to keep]"
ActiveSheet.Delete
Sheets(ActiveWorkbook.Sheets.Count).Select
Wend
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim ConnectionString As String
Dim StrQuery As String
Dim SOURCE As String
Dim DATABASE As String
Dim QUERY As String
Dim intColIndex As Integer
Dim sDate As String
Dim eDate As String
Dim qtr As Worksheet
Dim bqr As Worksheet
Dim bp As Worksheet
Set qtr = Sheets([sheet name])
Sheets.Add after:=qtr
Set bqr = ActiveSheet
bqr.Name = "[sheet name]"
Sheets.Add after:=bqr
Set bp = ActiveSheet
bp.Name = "[sheet name]"
SOURCE = "[server]"
DATABASE = "[database]"
sDate = UserForm1.TextBox1.Value
eDate = UserForm1.TextBox2.Value
QUERY = "[beginning of query]"
QUERY = QUERY + " [more query here]" 'This gets repeated a lot for each additional line in the query'
qtr.Select
Range("B6").Select
While ActiveCell.Value <> ""
QUERY = QUERY + " " + ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Wend
QUERY = QUERY + " [more query here]" 'This gets repeated a lot for the remaining lines in the query'
ConnectionString = "Provider=SQLOLEDB;Data Source=" & SOURCE & "; Initial Catalog=" & DATABASE & "; Integrated Security=SSPI;"
cnn.Open ConnectionString
cnn.CommandTimeout = 2000
StrQuery = QUERY
rst.Open StrQuery, cnn
bqr.Range("B6").CopyFromRecordset rst
For intColIndex = 0 To rst.Fields.Count - 1
Range("B5").Offset(0, intColIndex).Value = rst.Fields(intColIndex).Name
Next
End If
Application.DisplayAlerts = True
End Sub