If OptionButton2.Value = True Then Set Conn3 = New ADODB.Connection Conn3.ConnectionString = "driver={SQL Server};server=7.7.3.1;uid=" & UserForm1.TextBox1.Text & ";pwd=" & UserForm1.TextBox2.Text & ";database=MainDWH" Conn3.Open On Error Resume Next With ThisWorkbook.Worksheets(1) lLastrow = Cells(Rows.Count, 1).End(xlUp).Row i = 1 For Each iCell In .Range("A2", Cells(lLastrow, 1)) i = i + 1 If Cells(i, 63) <> "" Then GoTo Point3 lastName = iCell 'Фамилия firstName = iCell.Offset(0, 1) 'Имя secondName = iCell.Offset(0, 2) 'Отчество birthDate = iCell.Offset(0, 4) 'Датарождения sex = iCell.Offset(0, 6) 'Пол oldFIO = iCell.Offset(0, 3) birthPlace = iCell.Offset(0, 5) Set cmd3 = New ADODB.Command With cmd3 .ActiveConnection = Conn3 .Parameters.Append cmd1.CreateParameter("@lastName", adBSTR, adParamInput, Value:=lastName) .Parameters.Append cmd1.CreateParameter("@firstName", adBSTR, adParamInput, Value:=firstName) .Parameters.Append cmd1.CreateParameter("@secondName", adBSTR, adParamInput, Value:=secondName) .Parameters.Append cmd1.CreateParameter("@birthDate", adDBTimeStamp, adParamInput, Value:=birthDate) .Parameters.Append cmd1.CreateParameter("@sex", adBSTR, adParamInput, Value:=sex) .Parameters.Append cmd1.CreateParameter("@oldFIO", adBSTR, adParamInput, Value:=oldFIO) .Parameters.Append cmd1.CreateParameter("@birthPlace", adBSTR, adParamInput, Value:=birthPlace) .CommandType = adCmdStoredProc .CommandText = "port.sp_AfsSOAP_RequestTEST_BP" End With Set rs3 = cmd3.Execute() Cells(i, 63).CopyFromRecordset rs3 rs3.Close Point3: Next End With End If
[/vba]
ошибка о том что процедура не может принять пустую ячейку , но соль в том что в пятницу у меня всё работало когда стояло On Error Resume Next а сейчас даже если поставить то просто ничего не выводит (
У меня [vba]
Код
If OptionButton2.Value = True Then Set Conn3 = New ADODB.Connection Conn3.ConnectionString = "driver={SQL Server};server=7.7.3.1;uid=" & UserForm1.TextBox1.Text & ";pwd=" & UserForm1.TextBox2.Text & ";database=MainDWH" Conn3.Open On Error Resume Next With ThisWorkbook.Worksheets(1) lLastrow = Cells(Rows.Count, 1).End(xlUp).Row i = 1 For Each iCell In .Range("A2", Cells(lLastrow, 1)) i = i + 1 If Cells(i, 63) <> "" Then GoTo Point3 lastName = iCell 'Фамилия firstName = iCell.Offset(0, 1) 'Имя secondName = iCell.Offset(0, 2) 'Отчество birthDate = iCell.Offset(0, 4) 'Датарождения sex = iCell.Offset(0, 6) 'Пол oldFIO = iCell.Offset(0, 3) birthPlace = iCell.Offset(0, 5) Set cmd3 = New ADODB.Command With cmd3 .ActiveConnection = Conn3 .Parameters.Append cmd1.CreateParameter("@lastName", adBSTR, adParamInput, Value:=lastName) .Parameters.Append cmd1.CreateParameter("@firstName", adBSTR, adParamInput, Value:=firstName) .Parameters.Append cmd1.CreateParameter("@secondName", adBSTR, adParamInput, Value:=secondName) .Parameters.Append cmd1.CreateParameter("@birthDate", adDBTimeStamp, adParamInput, Value:=birthDate) .Parameters.Append cmd1.CreateParameter("@sex", adBSTR, adParamInput, Value:=sex) .Parameters.Append cmd1.CreateParameter("@oldFIO", adBSTR, adParamInput, Value:=oldFIO) .Parameters.Append cmd1.CreateParameter("@birthPlace", adBSTR, adParamInput, Value:=birthPlace) .CommandType = adCmdStoredProc .CommandText = "port.sp_AfsSOAP_RequestTEST_BP" End With Set rs3 = cmd3.Execute() Cells(i, 63).CopyFromRecordset rs3 rs3.Close Point3: Next End With End If
[/vba]
ошибка о том что процедура не может принять пустую ячейку , но соль в том что в пятницу у меня всё работало когда стояло On Error Resume Next а сейчас даже если поставить то просто ничего не выводит (Elhust