Selasa, 17 Juni 2014

Re: [MS_AccessPros] Re: List of Attachments

 

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

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


Warm Regards,
Crystal

 *
   (: have an awesome day :)
 *

image
Analyzer By Crystal
Analyzer demo video on YouTube
Preview by Yahoo




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