Option
Compare Database
Option
Explicit
Private
Const
TABLE_NAME
As
String
=
"tbl_Anlagen"
Private
Const
FIELD_NAME
As
String
=
"Anlage"
Private
Const
PATH
As
String
=
"C:\Users\Benutzer\Desktop\tmp"
Public
Sub
save_attachments()
On
Error
GoTo
errorhandler
Dim
db
As
DAO.Database
Dim
rs
As
DAO.Recordset, rs1
As
DAO.Recordset
Set
db = CurrentDb
Set
rs = db.OpenRecordset(
"SELECT "
& FIELD_NAME &
" FROM "
& TABLE_NAME &
";"
)
Do
While
Not
rs.EOF
Set
rs1 = rs.Fields(FIELD_NAME).Value
Do
While
Not
rs1.EOF
rs1.Fields(
"FileData"
).SaveToFile PATH
rs1.MoveNext
Loop
rs.MoveNext
Loop
On
Error
GoTo
0
clean_up:
Set
rs1 =
Nothing
Set
rs =
Nothing
Set
db =
Nothing
Exit
Sub
errorhandler:
MsgBox
"Es ist leider ein Fehler beim Speichern der Anlagen aufgetreteten."
& vbCrLf & _
"Fehlernummer: "
& Err.Number & vbCrLf & _
"Fehlerbeschreibung: "
& Err.Description, vbExclamation
GoTo
clean_up
End
Sub