ALTER PROCEDURE [port].[sp_AfsSOAP_RequestTEST_ALLL]
(
@DAT date
)
AS
BEGIN
DECLARE @ID nvarchar(20)
SELECT @ID= ANKETA_ID FROM port.Ankets

WHERE  ANKETA_BIRTH_DATE=CONVERT(DATETIME,'@DAT',104)

EXEC port.sp_AfsSOAP_RequestTEST_ID
@ID
END
GO

CREATE PROCEDURE [port].[sp_AfsSOAP_RequestTEST_ALL]
(
@FAM nvarchar(15),
@IM nvarchar(15),
@OT nvarchar(15),
@DAT date
)
AS
BEGIN
DECLARE @ID nvarchar(20)
SELECT @ID = ANKETA_ID FROM port.Ankets
WHERE  ANKETA_FAM=@FAM AND ANKETA_IM=@IM AND ANKETA_OT=@OT AND ANKETA_BIRTH_DATE=@DAT
EXEC port.sp_AfsSOAP_RequestTEST_ID
@ID
END
GO

Dim Conn
Sub test_connALL()
Dim cmd         As ADODB.Command
Dim Conn        As ADODB.Connection
Dim rs          As ADODB.Recordset
Dim lLastrow, i As Long
Dim iCell       As Range
Dim whereID     As Long
Dim FAM, IM, OT   As String
Dim DAT As Date

'On Error GoTo Err
iTimer! = Timer
Set Conn = New ADODB.Connection
'------------------------------------------------------------------------------------------------------------------
If UserForm1.TextBox2.Text = "" And UserForm1.TextBox1.Text = "" Then
UserForm1.Show
Else
End If
'------------------------------------------------------------------------------------------------------------------
Application.ScreenUpdating = False
'Range("G2:G65536").Clear
lLastrow = Cells(Rows.Count, 5).End(xlUp).Row
i = 1
'------------------------------------------------------------------------------------------------------------------
Conn.ConnectionString = "driver={SQL Server};server=197.76.8.177;uid=" & UserForm1.TextBox1.Text & ";pwd=" & UserForm1.TextBox2.Text & ";database=MainDWH"
Conn.Open
'------------------------------------------------------------------------------------------------------------------
'On Error Resume Next
With ThisWorkbook.Worksheets(2)
For Each iCell In .Range("E2", Cells(lLastrow, 5))
i = i + 1
If Cells(i, 68) <> "" Then GoTo Point
FAM = iCell
IM = iCell.Offset(0, 1)
OT = iCell.Offset(0, 2)
DAT = iCell.Offset(0, 4)
'MsgBox FAM & " " & IM & " " & OT
Set cmd = New ADODB.Command
     With cmd
          .ActiveConnection = Conn
          .Parameters.Append cmd.CreateParameter("@FAM", adBSTR, adParamInput, Value:=FAM)
          .Parameters.Append cmd.CreateParameter("@IM", adBSTR, adParamInput, Value:=IM)
          .Parameters.Append cmd.CreateParameter("@OT", adBSTR, adParamInput, Value:=OT)
          .Parameters.Append cmd.CreateParameter("@DAT", adDBTimeStamp, adParamInput, Value:=DAT)
          .CommandType = adCmdStoredProc
          .CommandText = "port.sp_AfsSOAP_RequestTEST_ALL"
     End With
     Set rs = cmd.Execute()
     Cells(i, 68).CopyFromRecordset rs
     rs.Close
Point:
Next
End With
'------------------------------------------------------------------------------------------------------------------
Application.ScreenUpdating = True
    MsgBox "Время выполнения макроса составило " & _
    Timer - iTimer! & " сек.", vbExclamation, ""
Conn.Close
Set rs = Nothing
Set con = Nothing
Exit Sub
'------------------------------------------------------------------------------------------------------------------
'Err:
'MsgBox ("Проверьте корректность ввода")
End Sub