1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
|
Private Sub Commande0_Click()
'Sub exportAttachments()
Dim strPath, fName, fldName, sName(3) As String
Dim rsPictures, rsDes As Variant
Dim rs As DAO.Recordset
Dim savedFile, i As Integer
savedFile = 0
strPath = Application.CurrentProject.Path
Set rs = CurrentDb.OpenRecordset("SELECT * FROM [t-clients]")
'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Not required here, but still a good habit
Do Until rs.EOF = True
On Error Resume Next 'ignore errors
'Instantiate the child record set.
Set rsPictures = rs.Fields("C:\Users\kiki\Desktop\EssaiSignature\").Value
Set rsDes = rs.Fields("NumeroVisite") 'use to name the picture later
'if no attachment available, go to next record
If Len(rsPictures.Fields("Signatureclient")) = 0 Then
GoTo nextRS
End If
If rsPictures.RecordCount <> 0 Then
rsPictures.MoveLast
savedFile = rsPictures.RecordCount 'set savedFile = total no of attachments
End If
rsPictures.MoveFirst ' move to first attachment file
'WARNING: all of my attachments are picture with JPG extension.
'loop through all attachments
For i = 1 To savedFile 'rename all files and save
If Not rsPictures.EOF Then
fName = strPath & "C:\Users\kiki\Desktop\EssaiSignature\" & rsDes & i & ".jpg"
rsPictures.Fields("signatureclient").SaveToFile fName
sName(i) = fName 'keep path in an array for later use
rsPictures.MoveNext
End If
Next i
'insert image name and path into database an edit
rs.Edit
If Len(sName(1)) <> 0 Then
rs!PicPath1 = CStr(sName(1)) 'path
rs!PicDes1 = Left(Dir(sName(1)), InStr(1, Dir(sName(1)), ".") - 1) 'file name without extension
End If
If Len(sName(2)) <> 0 Then
rs!PicPath2 = CStr(sName(2))
rs!PicDes2 = Left(Dir(sName(2)), InStr(1, Dir(sName(2)), ".") - 1)
End If
If Len(sName(3)) <> 0 Then
rs!PicPath3 = CStr(sName(3))
rs!PicDes3 = Left(Dir(sName(3)), InStr(1, Dir(sName(3)), ".") - 1)
End If
rs.Update 'update record
nextRS:
rsPictures.Close 'close attachment
savedFile = 0 'reset for next
fName = 0 'reset
'Move to the next record.
rs.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Pieces jointes exportées!"
rs.Close 'Close the db recordsets
Set rs = Nothing 'Clean up
End Sub |
Partager