VBA, MS Access MS Access в примерах

Переброска вложений из одного поля типа Attachment в другое

По сути это переброска из одного "рекордсета" в другой
В примере это реализовано одной кнопкой в оба направления.

Private Sub cmdTransfer_Click() ' Переброс вложений из одного поля в другое
Dim rst As DAO.Recordset
Dim rsSRC As DAO.Recordset
Dim rsDST As DAO.Recordset
Dim objField As DAO.Field
 
On Error GoTo CopyRecordToLog_Err
    
    Set rst = Me.RecordsetClone
    rst.Edit
  
'Определение направления переброски:
    If Me.Attachment01.AttachmentCount > 0 Then
        Set rsSRC = rst!Вложение01.Value  'Источник
        Set rsDST = rst!Вложение02.Value  'Назначение (куда)
    Else
        Set rsSRC = rst!Вложение02.Value  'Источник
        Set rsDST = rst!Вложение01.Value  'Назначение (куда)
    End If
 
'предварительная зачистка поля:
    If Me.CheckClearDistanationField = True Then
        With rsDST
             Do Until .EOF = True
                'Debug.Print "Удаляю: " & rsDST("FileName")
                .Delete
                .MoveNext
            Loop
        End With
    End If
    
'Перброска:
    With rsSRC
        Do Until .EOF = True
        rsDST.AddNew
            rsDST.Fields("FileData").Value = .Fields("FileData").Value
            rsDST.Fields("FileName").Value = .Fields("FileName").Value
        rsDST.Update
        .Delete
        .MoveNext
        Loop
    End With
    rst.Update
 
CopyRecordToLog_End:
    On Error Resume Next
    Set objField = Nothing
    rsSRC.Close:    Set rsSRC = Nothing
    rsDST.Close:    Set rsDST = Nothing
    rst.Close:      Set rst = Nothing
    Err.Clear
    Exit Sub
 
CopyRecordToLog_Err:
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in Sub: CopyRecordToLog in module: 00ModuleForTests", vbCritical, "Error in Application"
    Resume CopyRecordToLog_End
End Sub

Picture




Скачать

MSA-2007 и выше (6 101 kB) Пример


Назад ToTop
L.E. 16.07.2023
Рейтинг@Mail.ru