amir91
چهارشنبه 22 اسفند 1397, 14:36 عصر
با سلام
من می خواهم از کد زیر استفاده کنم ولی می خواهم اسم فایل من کپشن عکس ذخیره شده نباشد بلکه بر اساس کد شخص ذخیره شود
Option Compare Database
Private Sub Command5_Click()
On Error GoTo Err_SaveImage
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Set db = CurrentDb
Set rsParent = Me.Recordset
rsParent.OpenRecordset
With rsParent
.MoveFirst 'This ensures that regardless of your current record, the loop will start with the first record
Do While Not .EOF
Set rsChild = rsParent.Fields("Attachments").Value
With rsChild
Do While Not .EOF
If rsChild.RecordCount <> 0 Then
rsChild.OpenRecordset
rsChild.Fields("FileData").SaveToFile ("C:\Documents and Settings\ec\My Documents\Work\2012-12_db_export\test3")
rsChild.Delete
Me.Refresh
.MoveNext
Else
.MoveNext
End If
Loop
.Close
' MsgBox "Record cw"
End With
.MoveNext
Loop
.Close
'MsgBox "Recordset cw"
End With
Exit_SaveImage:
Set rsChild = Nothing
Set rsParent = Nothing
Exit Sub
Err_SaveImage:
If Err = 3839 Then
MsgBox ("File Already Exists in the Directory!")
Resume Next
Else
MsgBox "There's been an error!", Err.Number, Err.Description
Resume Exit_SaveImage
End If
End Sub
من می خواهم از کد زیر استفاده کنم ولی می خواهم اسم فایل من کپشن عکس ذخیره شده نباشد بلکه بر اساس کد شخص ذخیره شود
Option Compare Database
Private Sub Command5_Click()
On Error GoTo Err_SaveImage
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Set db = CurrentDb
Set rsParent = Me.Recordset
rsParent.OpenRecordset
With rsParent
.MoveFirst 'This ensures that regardless of your current record, the loop will start with the first record
Do While Not .EOF
Set rsChild = rsParent.Fields("Attachments").Value
With rsChild
Do While Not .EOF
If rsChild.RecordCount <> 0 Then
rsChild.OpenRecordset
rsChild.Fields("FileData").SaveToFile ("C:\Documents and Settings\ec\My Documents\Work\2012-12_db_export\test3")
rsChild.Delete
Me.Refresh
.MoveNext
Else
.MoveNext
End If
Loop
.Close
' MsgBox "Record cw"
End With
.MoveNext
Loop
.Close
'MsgBox "Recordset cw"
End With
Exit_SaveImage:
Set rsChild = Nothing
Set rsParent = Nothing
Exit Sub
Err_SaveImage:
If Err = 3839 Then
MsgBox ("File Already Exists in the Directory!")
Resume Next
Else
MsgBox "There's been an error!", Err.Number, Err.Description
Resume Exit_SaveImage
End If
End Sub