2

SSMS 2014 を呼び出してクエリを実行し、ワークシートの定義済みセルに結果を返すマクロがいくつかあります。それらは正常に機能しますが、一時テーブルで特定のクエリを使用しようとすると、次のエラー メッセージが表示されます。

VBA エラー メッセージ

私はオンラインで調査しましたが、見つけることができる最良の答え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
4

1 に答える 1