Private Sub Кнопка0_Click()
    Dim rcd As DAO.Recordset
    Dim db As DAO.Database
    Dim cnn1 As ADODB.Connection
    Dim rstEmployees As ADODB.Recordset
    Dim strCnn As String
    Dim varDate As Variant
    Dim SSql As String
    Dim p As String
    Dim result As Integer
    Dim fileName As String
    Dim month As String
    Dim rcd1 As DAO.Recordset
    Dim rcd2 As DAO.Recordset
    Dim mycat As ADOX.Catalog
        DoCmd.RunSQL "delete * from balance"
       ' Open connection.
 Dim a As Integer
With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Выбор проекта"
        '.Filters.Add "Все файлы", "*.*"
        .Filters.Add "Проекты", "*.mpp"
        .FilterIndex =  1 
        .AllowMultiSelect = False
        .InitialFileName = CurrentProject.Path
        result = .Show
        If result <>  0  Then
        p = Trim(.SelectedItems.Item( 1 ))
        End If
        End With
        If p = "" Then GoTo n1
        Set db = CurrentDb
        
   strCnn = "Provider=Microsoft.Project.OLEDB.10.0;Project Name=" & p
   SSql = "SELECT Taskcost,TaskName,Taskfinish,TaskType,TaskoutlineLevel,Taskstart,TaskOutLineNumber FROM Tasks"
    
    Set cnn1 = New ADODB.Connection
    cnn1.Open strCnn
    
  ' Open employee table.
    Set rstEmployees = New ADODB.Recordset
    rstEmployees.CursorType = adOpenKeyset
    rstEmployees.LockType = adLockOptimistic
    rstEmployees.Open SSql, cnn1, , , adCmdText
    
    ' Попытка решения задачи
    '--------------------------------------------
    Set rcd = db.OpenRecordset("balance", dbOpenDynaset, dbSeeChanges)
      Do While Not rstEmployees.EOF
          msg = rstEmployees.Fields.Item("taskcost")
          msg1 = rstEmployees.Fields.Item("taskname")
          msg2 = rstEmployees.Fields.Item("taskfinish")
          msg3 = rstEmployees.Fields.Item("tasktype")
          msg4 = CStr(rstEmployees.Fields.Item("taskoutlinelevel"))
          msg5 = rstEmployees.Fields.Item("TaskStart")
          msg6 = DateDiff("m", msg5, msg2) + 1
          msg7 = rstEmployees.Fields.Item("taskOutLineNumber")
      rcd.AddNew
      rcd!name_balance = msg1
      rcd!price_balance = msg / 100
      rcd!ftime_balance = msg2
      rcd!stime_balance = msg5
      rcd!type_balance = msg3
      rcd!level_balance = msg4
      rcd!Duration = msg6
      rcd!Level = msg7
      rcd.Update
      rstEmployees.MoveNext
       Loop
      cnn1.Close
      rcd.Close
      Set cnn1 = Nothing
    Set rstEmployees = Nothing

Call isprav
Set mycat = New ADOX.Catalog
mycat.ActiveConnection = CurrentProject.Connection
If XTblTest(mycat, "svod") = True Then
    DoCmd.RunSQL "Drop table svod;"
    End If
    
' ---------------------------------------------------------------
 
    DoCmd.RunSQL "SELECT balance.name_balance INTO Svod FROM balance;"
    Set rcd = db.OpenRecordset("period", dbOpenSnapshot, dbSeeChanges)
 Do
    If rcd.EOF Then Exit Do
    'month = CStr(Left(rcd!start_time, 2)) & "_" & CStr(Right(rcd!start_time, 2))
     month = Change(rcd!start_time) & "_" & CStr(Right(rcd!start_time, 2))
    DoCmd.RunSQL "ALTER TABLE svod ADD COLUMN " & month & " long;"
    Set rcd1 = db.OpenRecordset("svod", dbOpenDynaset, dbSeeChanges)
    Set rcd2 = db.OpenRecordset("balance", dbOpenSnapshot, dbSeeChanges)
While Not rcd1.EOF
While Not rcd2.EOF
    rcd1.Edit
    If rcd2!type_balance <> 0 Then
    rcd1.Fields(month) = Null
    End If
    If rcd2!type_balance = 0 Then
    If (Format(rcd2!stime_balance, "mm.yyyy")) <= rcd!start_time And (Format(rcd2!ftime_balance, "mm.yyyy")) >= rcd!start_time Then
    rcd1.Fields(month) = rcd2!price_balance / rcd2!Duration
        End If
        End If
        rcd1.Update
        rcd1.MoveNext
        rcd2.MoveNext
Wend
Wend
        rcd.MoveNext
        rcd1.Close
        rcd2.Close
    Loop
        rcd.Close
        MsgBox ("Загрузка данных из проекта успешно выполнена")
' ----------------------------------------------------------------
 
        n1:
    End Sub