'рекордсет на запись для редактирования
Private rsCurrentEmp As ADODB.Recordset
'Command-объект на запись для редактирования
Private cmdCurrentEmp As New ADODB.Command
Private rsNameOrg As ADODB.Recordset

Private Sub Command1_Click()
 CommonDialog1.ShowOpen
 If CommonDialog1.FileName <>  "" Then Image1.Picture = LoadPicture(CommonDialog1.FileName)
End Sub

'инфа в статусбар
Private Sub Form_Activate()
  frmMain.sbrMain.Panels(1).Text = "Редактирование записи"
End Sub

Private Sub Form_Load()
 Me.Caption = "Редактирование записи"
 orgNameRS
 'параметры CommonDialog'а
 CommonDialog1.Flags = cdlOFNFileMustExist
 CommonDialog1.Flags = cdlOFNHideReadOnly
 CommonDialog1.InitDir = "C:\"
 CommonDialog1.Filter = "Графические файлы (*.jpg) | *.jpg"

 'Длина полей
 txtEmp(0 ).MaxLength =  50 
 txtEmp( 1 ).MaxLength =  20 
 txtEmp( 2 ).MaxLength =  20 
 txtEmp( 3 ).MaxLength =  100 
 txtEmp( 4 ).MaxLength =  200 
 txtEmp( 5 ).MaxLength =  50 
 txtEmp( 6 ).MaxLength =  200 
 txtEmp( 7 ).MaxLength =  50 
 txtEmp( 10 ).MaxLength =  40 
 txtEmp( 11 ).MaxLength =  8 
 
 Me.Refresh
 
 'из какого рекордсета какое поле :)
 Set DataCombo1.RowSource = rsNameOrg
 DataCombo1.ListField = "name"
 
 If frmEmployee.newRecord = False Then
  currentRec
 Else
  DataCombo1.Text = "ООО ДНК"
 End If
 
 Me.Refresh
 
 End Sub

'Записи в comboBox
Private Sub orgNameRS()
 Dim cnNameOrg As New ADODB.Command
 Set cnNameOrg.ActiveConnection = frmLogon.cn
  cnNameOrg.CommandText = "procAllMyOrg "
  cnNameOrg.CommandType = adCmdStoredProc

Set rsNameOrg = New ADODB.Recordset
 With rsNameOrg
   .LockType = adLockReadOnly
   .CursorType = adOpenStatic
   .CursorLocation = adUseClient
   .Open cnNameOrg
  End With
End Sub

'Редактирование/просмотр выбранной записи
Private Sub currentRec()
 'Выполняем хранимую процедуру и передаем запись в рекордсет
 Dim prm As ADODB.Parameter
 Set cmdCurrentEmp.ActiveConnection = frmLogon.cn
  cmdCurrentEmp.CommandText = " procKadresCurrRec "
  cmdCurrentEmp.CommandType = adCmdStoredProc
 'Заполняем параметры
 Set prm = cmdCurrentEmp.CreateParameter("currRec", adInteger, adParamInput, , frmEmployee.idCount)
   cmdCurrentEmp.Parameters.Append prm

   cmdCurrentEmp.Prepared = True
   cmdCurrentEmp.Execute

 'Рекордсет с текущей записью
  Set rsCurrentEmp = New ADODB.Recordset
  With rsCurrentEmp
   .LockType = adLockOptimistic
   .CursorType = adOpenStatic
   .CursorLocation = adUseServer
   .Open cmdCurrentEmp
  End With

 'Привязка к полям
 Set txtEmp(0).DataSource = rsCurrentEmp
  txtEmp(0).DataField = "fio"
 
 Set txtEmp(1).DataSource = rsCurrentEmp
  txtEmp(1).DataField = "phone"
 
 Set txtEmp(2).DataSource = rsCurrentEmp
  txtEmp(2).DataField = "mobile"
 
 Set txtEmp(3).DataSource = rsCurrentEmp
  txtEmp(3).DataField = "homeInfo"
 
 Set txtEmp(4).DataSource = rsCurrentEmp
  txtEmp(4).DataField = "homeAddress"
 
 Set txtEmp(5).DataSource = rsCurrentEmp
  txtEmp(5).DataField = "car"
 
 Set txtEmp(6).DataSource = rsCurrentEmp
  txtEmp(6).DataField = "education"
 
 Set txtEmp(7).DataSource = rsCurrentEmp
  txtEmp(7).DataField = "family"
 
 'Присваивается тексту в comboB значение поля соответствующего id
 rsNameOrg.MoveFirst
 rsNameOrg.Find " id= " & rsCurrentEmp.Fields(" organisation ").Value
 DataCombo1.Text = rsNameOrg.Fields(" name ").Value
 
 Set dtpDateContract.DataSource = rsCurrentEmp
  dtpDateContract.DataField = " dateContract "
 
 Set txtEmp(10 ).DataSource = rsCurrentEmp
  txtEmp( 10 ).DataField = "jobTitle "
 
 Set txtEmp(11 ).DataSource = rsCurrentEmp
  txtEmp( 11 ).DataField = "salary "
 
 Set dtpBirthDay.DataSource = rsCurrentEmp
  dtpBirthDay.DataField = " birthDay "
  
 Set txtInfo.DataSource = rsCurrentEmp
  txtInfo.DataField = " info "
  
 Set Image1.DataSource = rsCurrentEmp
  Image1.DataField = " photo "
 
 chkStatus.Value = rsCurrentEmp.Fields(" status ").Value
 
End Sub
Private Sub cmdSave_Click()

'Проверяем заполнение поля "ФИО"
 If txtEmp(0).Text = "" Then
  MsgBox "Для сохранения необходимо заполненить поле " & Chr$(34) & "ФИО" & Chr$(34) & ".", vbInformation, "ДНК-Кадры"
  Exit Sub
 Else
  'проверяем новая запись или исправление текущей
  If frmEmployee.newRecord = True Then
   'Command-объект на запись
   Dim cmdSave As New ADODB.Command
   Dim prm As ADODB.Parameter
   Set cmdSave.ActiveConnection = frmLogon.cn
   cmdSave.CommandText = "procKadresSave"
   cmdSave.CommandType = adCmdStoredProc
 
  'Заполняем параметры
   Set prm = cmdSave.CreateParameter(" fio ", adVarChar, adParamInput, 80 , Trim(txtEmp( 0 ).Text))
    cmdSave.Parameters.Append prm
   Set prm = cmdSave.CreateParameter("phone ", adVarChar, adParamInput, 20 , Trim(txtEmp( 1 ).Text))
    cmdSave.Parameters.Append prm
   Set prm = cmdSave.CreateParameter("mobile ", adVarChar, adParamInput, 20 , Trim(txtEmp( 2 ).Text))
    cmdSave.Parameters.Append prm
   Set prm = cmdSave.CreateParameter("homeInfo ", adVarChar, adParamInput, 100 , Trim(txtEmp( 3 ).Text))
    cmdSave.Parameters.Append prm
   Set prm = cmdSave.CreateParameter("homeAddress ", adVarChar, adParamInput, 200 , Trim(txtEmp( 4 ).Text))
    cmdSave.Parameters.Append prm
   Set prm = cmdSave.CreateParameter("car ", adVarChar, adParamInput, 50 , Trim(txtEmp( 5 ).Text))
    cmdSave.Parameters.Append prm
   Set prm = cmdSave.CreateParameter("education ", adVarChar, adParamInput, 200 , Trim(txtEmp( 6 ).Text))
    cmdSave.Parameters.Append prm
   Set prm = cmdSave.CreateParameter("family ", adVarChar, adParamInput, 50 , Trim(txtEmp( 7 ).Text))
    cmdSave.Parameters.Append prm
   rsNameOrg.MoveFirst
   rsNameOrg.Find "name='" & DataCombo1.Text & "' "
   Set prm = cmdSave.CreateParameter(" organisation ", adVarChar, adParamInput, 40 , rsNameOrg.Fields("id ").Value)
    cmdSave.Parameters.Append prm
   Set prm = cmdSave.CreateParameter(" dateContract ", adVarChar, adParamInput, 10 , dtpDateContract.Month & ". " & dtpDateContract.Day & " . " & dtpDateContract.Year)
    cmdSave.Parameters.Append prm
   Set prm = cmdSave.CreateParameter(" jobTitle ", adVarChar, adParamInput, 40 , Trim(txtEmp( 10 ).Text))
    cmdSave.Parameters.Append prm
   Set prm = cmdSave.CreateParameter("salary ", adCurrency, adParamInput, , Val(txtEmp(11 ).Text))
    cmdSave.Parameters.Append prm
   Set prm = cmdSave.CreateParameter("birthDay ", adVarChar, adParamInput, 10 , dtpBirthDay.Month & ". " & dtpBirthDay.Day & " . " & dtpBirthDay.Year)
    cmdSave.Parameters.Append prm
   Set prm = cmdSave.CreateParameter(" info ", adLongVarChar, adParamInput, Len(txtInfo.TextRTF) + 1 , txtInfo.TextRTF)
    cmdSave.Parameters.Append prm
  
   'Создаем временный файл для фотографии и читаем из него в бин. данные
   Dim FileBuff() As Byte
   Dim FileLen As Long

   SavePicture Image1.Picture, "tempfile.bin"
   Open "tempfile.bin" For Binary As #1
   FileLen = LOF(1)
   ReDim FileBuff(FileLen) As Byte
   Get #1, , FileBuff()
   Close #1
   'Удаляем временный файл
   Kill ("tempfile.bin ")
  
   'заливаем бин. в параметр для хранимой процедуры
   Set prm = cmdSave.CreateParameter("photo", adLongVarBinary, adParamInput, FileLen + 1, FileBuff)
    cmdSave.Parameters.Append prm
   Set prm = cmdSave.CreateParameter("status", adInteger, adParamInput, , chkStatus.Value)
    cmdSave.Parameters.Append prm
    
   'сюда дадут id новой записи
   Set prm = cmdSave.CreateParameter(" newId ", adInteger, adParamOutput)
    cmdSave.Parameters.Append prm
    
    cmdSave.Prepared = True
    'снятие блокировки с записи
    Set rsCurrentEmp = Nothing
    'обновление записи
    cmdSave.Execute
   
   'сохраняем параметры грида
   frmEmployee.saveGridParams
    
   'Обновляем записи и параметры грида в форме со списком
   frmEmployee.rsEmp.Requery
   frmEmployee.gridParams
   
   'загружаем сохраненные параметры
   frmEmployee.loadGridParams
   
   'Переходим на добавленную запись
   frmEmployee.rsEmp.MoveFirst
   frmEmployee.rsEmp.Find (" id= " & cmdSave.Parameters(" newId ").Value)
   
   'Количество записей в статусбар
   frmMain.sbrMain.Panels(2).Text = "Всего записей: " & frmEmployee.rsEmp.RecordCount
    
   Set cmdSave = Nothing
   Set prm = Nothing
         
   Set cmdCurrentEmp = Nothing
   Set frmEmployeeMore = Nothing
   
   Unload Me
          
  Else
   'Если нет флага на создание новой записи, то обновляем текущую
    'Command-объект на запись
   Dim cmdUpdate As New ADODB.Command
   Dim prmUpdate As ADODB.Parameter
   Set cmdUpdate.ActiveConnection = frmLogon.cn
   cmdUpdate.CommandText = "procKadresUpdateRec"
   cmdUpdate.CommandType = adCmdStoredProc
 
  'Заполняем параметры
   Set prmUpdate = cmdUpdate.CreateParameter(" idRec ", adInteger, adParamInput, , frmEmployee.rsEmp.Fields(" id ").Value)
    cmdUpdate.Parameters.Append prmUpdate
   Set prmUpdate = cmdUpdate.CreateParameter(" fio ", adVarChar, adParamInput, 80 , txtEmp( 0 ).Text)
    cmdUpdate.Parameters.Append prmUpdate
   Set prmUpdate = cmdUpdate.CreateParameter("phone ", adVarChar, adParamInput, 20 , txtEmp( 1 ).Text)
    cmdUpdate.Parameters.Append prmUpdate
   Set prmUpdate = cmdUpdate.CreateParameter("mobile ", adVarChar, adParamInput, 20 , txtEmp( 2 ).Text)
    cmdUpdate.Parameters.Append prmUpdate
   Set prmUpdate = cmdUpdate.CreateParameter("homeInfo ", adVarChar, adParamInput, 100 , txtEmp( 3 ).Text)
    cmdUpdate.Parameters.Append prmUpdate
   Set prmUpdate = cmdUpdate.CreateParameter("homeAddress ", adVarChar, adParamInput, 200 , txtEmp( 4 ).Text)
    cmdUpdate.Parameters.Append prmUpdate
   Set prmUpdate = cmdUpdate.CreateParameter("car ", adVarChar, adParamInput, 50 , txtEmp( 5 ).Text)
    cmdUpdate.Parameters.Append prmUpdate
   Set prmUpdate = cmdUpdate.CreateParameter("education ", adVarChar, adParamInput, 200 , txtEmp( 6 ).Text)
    cmdUpdate.Parameters.Append prmUpdate
   Set prmUpdate = cmdUpdate.CreateParameter("family ", adVarChar, adParamInput, 50 , txtEmp( 7 ).Text)
    cmdUpdate.Parameters.Append prmUpdate
   rsNameOrg.MoveFirst
   rsNameOrg.Find "name='" & DataCombo1.Text & "' "
   Set prmUpdate = cmdUpdate.CreateParameter(" organisation ", adVarChar, adParamInput, 40 , rsNameOrg.Fields("id ").Value)
    cmdUpdate.Parameters.Append prmUpdate
   Set prmUpdate = cmdUpdate.CreateParameter(" dateContract ", adVarChar, adParamInput, 10 , dtpDateContract.Month & ". " & dtpDateContract.Day & " . " & dtpDateContract.Year)
    cmdUpdate.Parameters.Append prmUpdate
   Set prmUpdate = cmdUpdate.CreateParameter(" jobTitle ", adVarChar, adParamInput, 40 , txtEmp( 10 ).Text)
    cmdUpdate.Parameters.Append prmUpdate
   Set prmUpdate = cmdUpdate.CreateParameter("salary ", adCurrency, adParamInput, , Val(txtEmp(11 ).Text))
    cmdUpdate.Parameters.Append prmUpdate
   Set prmUpdate = cmdUpdate.CreateParameter("birthDay ", adVarChar, adParamInput, 10 , dtpBirthDay.Month & ". " & dtpBirthDay.Day & " . " & dtpBirthDay.Year)
    cmdUpdate.Parameters.Append prmUpdate
   Set prmUpdate = cmdUpdate.CreateParameter(" info ", adLongVarChar, adParamInput, Len(txtInfo.TextRTF) + 1 , txtInfo.TextRTF)
    cmdUpdate.Parameters.Append prmUpdate
   
   
   'Создаем временный файл для фотографии и читаем из него в бин. данные
   Dim FileBuff1() As Byte
   Dim FileLen1 As Long

   SavePicture Image1.Picture, "tempfile.bin"
   Open "tempfile.bin" For Binary As #1
   FileLen1 = LOF(1)
   ReDim FileBuff1(FileLen1) As Byte
   Get #1, , FileBuff1()
   Close #1
   'Удаляем временный файл
   Kill ("tempfile.bin ")
  
   'заливаем бин. в параметр для хранимой процедуры
   Set prmUpdate = cmdUpdate.CreateParameter("photo", adLongVarBinary, adParamInput, FileLen1 + 1, FileBuff1)
    cmdUpdate.Parameters.Append prmUpdate
   
  Set prmUpdate = cmdUpdate.CreateParameter("status", adInteger, adParamInput, , chkStatus.Value)
    cmdUpdate.Parameters.Append prmUpdate
   
    cmdUpdate.Prepared = True
    cmdUpdate.Execute
   
   'сохраняем параметры грида
   frmEmployee.saveGridParams
   
   'Обновляем записи и параметры грида в форме со списком
   frmEmployee.rsEmp.Requery
   frmEmployee.gridParams
   
   'загружаем сохраненные параметры
   frmEmployee.loadGridParams
   
   'переходим на текущую запись
   frmEmployee.rsEmp.MoveFirst
   frmEmployee.rsEmp.Find ("id=" & cmdUpdate.Parameters("idRec").Value)
   
   'Количество записей в статусбар
   frmMain.sbrMain.Panels(2 ).Text = "Всего записей: " & frmEmployee.rsEmp.RecordCount
   
   Set cmdUpdate = Nothing
   Set prmUpdate = Nothing
         
      
   Set cmdCurrentEmp = Nothing
   Set rsCurrentEmp = Nothing
   Set frmEmployeeMore = Nothing
    
   Unload Me
  End If
 End If
End Sub
Private Sub cmdDel_Click()
 frmEmployee.deleteRec
End Sub

Private Sub cmdExit_Click()
 Set cmdCurrentEmp = Nothing
 Set rsCurrentEmp = Nothing
 Set frmEmployeeMore = Nothing
 Unload Me
End Sub