Hi Kat,
here is some code to save attachments to external files (much easier to manage) ~ in any case, this show you how to get to the data you want :)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub run_SaveAttachmentsToFiles()
'130117
SaveAttachmentsToFiles "Props", "pScrShot", "PropID" _
, , "propAtt", "propFile"
End Sub
Sub SaveAttachmentsToFiles( _
ByVal sTableName As String _
, ByVal sFieldName_Att As String _
, ByVal sFieldName_ID As String _
, Optional ByVal sPath As String = "" _
, Optional ByVal sTableNameChild As String = "" _
, Optional ByVal sFilenameField As String = "" _
)
'130117 Crystal strive4peace
'PARAMETERS
' sTableName = name of table with attachment field
' sFieldName_Att = name of attachment field
' sFieldName_ID = name of PK
' sPath - optional. If not specified, written to c:\CurrentDbPath\Attachments
' WRITE CHILD RECORDS
' assumption: FK = sFieldName_ID (same as parent table)
' sTableNameChild - optional. name of related table
' sFilenameField - fieldname in child table for Filename
On Error GoTo Proc_Err
Dim db As DAO.Database _
, rs As DAO.Recordset _
, rs2 As DAO.Recordset2 _
, fld2 As DAO.Field2
Dim sPathFile As String _
, nNum As Long _
, sSQL As String
nNum = 0
If sPath = "" Then
sPath = CurrentProject.Path & "\Attachments\"
If Dir(sPath, vbDirectory) = "" Then
MkDir sPath
DoEvents
End If
Else
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
End If
Set db = CurrentDb
Set rs = db.OpenRecordset(sTableName, dbOpenDynaset)
Do While Not rs.EOF
Set rs2 = rs.Fields(sFieldName_Att).Value
With rs2
Do While Not .EOF
sPathFile = sPath _
& sTableName & "_" _
& Replace( _
Replace(rs2.Fields("FileName").Value _
, ".jpg", "_" & rs(sFieldName_ID).Value & ".jpg") _
, ".png", rs(sFieldName_ID).Value & ".png")
If Dir(sPathFile) <> "" Then
' set attribute to Normal in case it is ReadOnly
' VBA.SetAttr sPathFile, vbNormal
Kill sPathFile
End If
Set fld2 = rs2.Fields("FileData")
fld2.SaveToFile sPathFile
nNum = nNum + 1
If sTableNameChild <> "" And sFilenameField <> "" Then
'current database directory is stripped from path
'if path starts with \ then it is relative to database directory
sSQL = "INSERT INTO " & sTableNameChild _
& "(" & sFieldName_ID & ", " & sFilenameField & ")" _
& " SELECT " & rs(sFieldName_ID).Value _
& ", """ & Replace(sPathFile, CurrentProject.Path, "") & """;"
With db
.Execute sSQL
If Not .RecordsAffected > 0 Then
If MsgBox("Error creating Child Record for " _
& sPathFile, vbOKCancel, "Error -- continue anyway") = vbCancel Then
GoTo Proc_Exit
End If
End If
End With
End If
.MoveNext
Loop 'rs2
.Close
End With 'rs2
rs.MoveNext
Loop 'rs
MsgBox "Created " & nNum & " Files from Attachments" _
, , "Done"
Proc_Exit:
On Error Resume Next
'release object variables
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
If Not rs2 Is Nothing Then
rs2.Close
Set rs2 = Nothing
End If
Set db = Nothing
Exit Sub
Proc_Err:
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " SaveAttachmentsToFiles"
Resume Proc_Exit
Resume
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'130117
SaveAttachmentsToFiles "Props", "pScrShot", "PropID" _
, , "propAtt", "propFile"
End Sub
Sub SaveAttachmentsToFiles( _
ByVal sTableName As String _
, ByVal sFieldName_Att As String _
, ByVal sFieldName_ID As String _
, Optional ByVal sPath As String = "" _
, Optional ByVal sTableNameChild As String = "" _
, Optional ByVal sFilenameField As String = "" _
)
'130117 Crystal strive4peace
'PARAMETERS
' sTableName = name of table with attachment field
' sFieldName_Att = name of attachment field
' sFieldName_ID = name of PK
' sPath - optional. If not specified, written to c:\CurrentDbPath\Attachments
' WRITE CHILD RECORDS
' assumption: FK = sFieldName_ID (same as parent table)
' sTableNameChild - optional. name of related table
' sFilenameField - fieldname in child table for Filename
On Error GoTo Proc_Err
Dim db As DAO.Database _
, rs As DAO.Recordset _
, rs2 As DAO.Recordset2 _
, fld2 As DAO.Field2
Dim sPathFile As String _
, nNum As Long _
, sSQL As String
nNum = 0
If sPath = "" Then
sPath = CurrentProject.Path & "\Attachments\"
If Dir(sPath, vbDirectory) = "" Then
MkDir sPath
DoEvents
End If
Else
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
End If
Set db = CurrentDb
Set rs = db.OpenRecordset(sTableName, dbOpenDynaset)
Do While Not rs.EOF
Set rs2 = rs.Fields(sFieldName_Att).Value
With rs2
Do While Not .EOF
sPathFile = sPath _
& sTableName & "_" _
& Replace( _
Replace(rs2.Fields("FileName").Value _
, ".jpg", "_" & rs(sFieldName_ID).Value & ".jpg") _
, ".png", rs(sFieldName_ID).Value & ".png")
If Dir(sPathFile) <> "" Then
' set attribute to Normal in case it is ReadOnly
' VBA.SetAttr sPathFile, vbNormal
Kill sPathFile
End If
Set fld2 = rs2.Fields("FileData")
fld2.SaveToFile sPathFile
nNum = nNum + 1
If sTableNameChild <> "" And sFilenameField <> "" Then
'current database directory is stripped from path
'if path starts with \ then it is relative to database directory
sSQL = "INSERT INTO " & sTableNameChild _
& "(" & sFieldName_ID & ", " & sFilenameField & ")" _
& " SELECT " & rs(sFieldName_ID).Value _
& ", """ & Replace(sPathFile, CurrentProject.Path, "") & """;"
With db
.Execute sSQL
If Not .RecordsAffected > 0 Then
If MsgBox("Error creating Child Record for " _
& sPathFile, vbOKCancel, "Error -- continue anyway") = vbCancel Then
GoTo Proc_Exit
End If
End If
End With
End If
.MoveNext
Loop 'rs2
.Close
End With 'rs2
rs.MoveNext
Loop 'rs
MsgBox "Created " & nNum & " Files from Attachments" _
, , "Done"
Proc_Exit:
On Error Resume Next
'release object variables
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
If Not rs2 Is Nothing Then
rs2.Close
Set rs2 = Nothing
End If
Set db = Nothing
Exit Sub
Proc_Err:
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " SaveAttachmentsToFiles"
Resume Proc_Exit
Resume
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Warm Regards,
Crystal
*
(: have an awesome day :)
*
On Friday, June 6, 2014 3:49 AM, "Peter Poppe plpoppe@gmail.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:
I believe that you said in your table you have a field for the file name and a hyperlink field. In truth you only need the hyperlink field, because you can extract the name from there, but having a dedicated field would make it simpler except requires a little extra work to type in the name. If that is the case, then in your sub report just remove the hyperlink field and only display the file name field.
On Tue, Jun 3, 2014 at 12:32 PM, ka0t1c_ang3l <no_reply@yahoogroups.com> wrote:
Peter-I finally got the report to display the list of attachments; however, the list displays the name of the attachment and the hyperlink. How do I make it display only the name of the attachment?Thanks!! :)
__._,_.___
Posted by: Crystal <strive4peace2008@yahoo.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (31) |
.
__,_._,___
Tidak ada komentar:
Posting Komentar