Переброска вложений из одного поля типа 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
.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
MSA-2007 и выше (6 101 kB) Пример
|