запрос в ssms отрабатывает норм (N записей >0)
ADO рекордсет возвращает 0
| Код |
Sub SServer_extractdata()
Dim conn As ADODB.Connection
Dim recset As ADODB.Recordset
Dim sql As String
Dim rnfrom As Range
Dim rn As Range
Dim x As Long: Dim y As Integer: Dim z As Integer
On Error Resume Next
Set rnfrom = Application.InputBox("Выберите 1 ячейку с текстом sql в примечании", "Ananiev_G:Request", Type:=8)
If rnfrom Is Nothing Then GoTo 10
If rnfrom.Cells.Count <> 1 Then GoTo 10
If rnfrom.Comment.Text = Null Then GoTo 10
On Error GoTo 0
On Error Resume Next
Set rn = Application.InputBox("Выберите ячейку начала импорта", "Ananiev_G:Request", Type:=8)
If rn Is Nothing Then GoTo 10
On Error GoTo 0
Set conn = New ADODB.Connection
conn.Open "Provider=SQLOLEDB;Data Source=SQL-AXAPTA-3;Initial Catalog=POSReports;user id=ananev-g;Trusted_Connection=Yes"
'Data Source - это Server; Initial Catalog - это БД
Let sql = Trim(Application.Clean(rnfrom.Comment.Text)) 'удаляем символ переноса строки
'Let sql = "use POSReports select top 100 customername from salesreportform1"
Debug.Print sql
Set recset = New ADODB.Recordset
With recset
.ActiveConnection = conn
On Error Resume Next
.Open sql
If Err.Number = -2147217900 Then
MsgBox "Некорректный текст sql в примечании", vbCritical, "Ananiev_G:Allert"
GoTo 10
End If
End With
If (rn.Row + recset.RecordCount) >= 65636 Then
MsgBox "Количество записей от стартовой ячейки превышает размеры листа по количеству строк", vbCritical, "Ananiev_G:Allert"
GoTo 10
End If
If recset.RecordCount = -1 Then
MsgBox "Запрос вернул 0 записей", vbCritical, "Ananiev_G:Allert"
GoTo 10
End If
recset.MoveFirst
Let x = 0: Let y = 0: Let z = recset.Fields.Count
Do Until recset.EOF
For y = 0 To z - 1 Step 1 'Fields.Count-считает с 1 до N;recset.Fields()-считает с 0 до N
Let rn.Offset(x, y) = recset.Fields(y)
Next
recset.MoveNext
Let x = x + 1
Loop
10: Set recset = Nothing
conn.Close
On Error GoTo 0
End Sub
'like
|
|