ACCESS FEED: Re: [MS_AccessPros] Re: List of Attachments

... oops, I meant to say "Hi Kat" (hi to Liz too ~ )

On Thursday, May 29, 2014 8:12 AM, "Crystal strive4peace2008@yahoo.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:

Hi Liz,

what kind of attachments are they? Here is some code I use to save attachments to files ... that would be a good thing to do :) Hopefully you can see the logic to replace the calls to other procedures. I use a database property to keep track of the path for attachments. When users navigate to attach a file, a copy of the file is made and it is store in the specified attachments directory. An ID is added to ensure it is unique if another file has the same name. the reason I note image files is to display them on the form. Other file types are not automatically rendered in the app I wrote this for. One of my clients downloaded a template -- and those have attachment fields all over the place! I converted them all to external files.

I may have a later version of the code that is generic as I see this is from nearly a year ago ... but right now I am getting ready to make a video tutorial so I don't want to get sidetracked ~ hope this helps you

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

'mod_SaveAttachmentsToFiles

Sub run_SaveAttachmentsToFiles()
'130117, 913
   Dim sTablename As String _
   , sFieldName_Att As String _
   , sFieldName_ID As String _
   , sPath As String _
   , nTID As Long

   sTablename = "COMPLETED PROJECTS"
   sFieldName_Att = "Attachments"
   sFieldName_ID = "ID"
'   sPath
   nTID = 399

   Custom_SetDefaultProperties

   SaveAttachmentsToFiles sTablename, sFieldName_Att, sFieldName_ID, nTID
End Sub

Sub SaveAttachmentsToFiles( _
   ByVal psTablename As String _
   , ByVal psFld_Attachment As String _
   , ByVal psFld_ID As String _
   , ByVal pnTID As Long _
   , Optional ByVal psPathAttachments As String = "" _
   )
'130117 Crystal strive4peace, ...130913
   'PARAMETERS
   ' psTableName = name of table with attachment field
   ' psFld_Attachment = name of attachment field
   ' psFld_ID = name of PK
   ' psPathAttachments - optional. If not specified, written to c:\CurrentDbPath\Attachments or value of :
   ' local_PathAttachments
   '   WRITE CHILD RECORDS
   '   assumption: FK = psFld_ID (same as parent table) if sFieldNameChild_ID not specified

    On Error GoTo Proc_Err

    Dim db As DAO.Database _
      , rs As DAO.Recordset _
      , rsFilename As DAO.Recordset _
      , rs2 As DAO.Recordset2 _
      , fld2 As DAO.Field2

   Dim sPathFile As String _
      , sFilename As String _
      , sFileExtension As String _
      , iPos As Integer _
      , nRecordID As Long _
      , nAttLinkID As Long _
      , nNumFilesCreated As Long _
      , sSQL As String

   nNumFilesCreated = 0

   If psPathAttachments = "" Then
      psPathAttachments = Get_Property("local_PathAttachment")
      If Not Len(Trim(psPathAttachments)) > 0 Then
         psPathAttachments = CurrentProject.Path & "\Attachments\"
         Call Set_Property("local_PathAttachment", psPathAttachments)
      End If
   Else
      If Right(psPathAttachments, 1) <> "\" Then psPathAttachments = psPathAttachments & "\"
      Call Set_Property("local_PathAttachment", psPathAttachments)
   End If

   If Dir(psPathAttachments, vbDirectory) = "" Then
      MkDir psPathAttachments
      DoEvents
   End If

   Set db = CurrentDb
   Set rs = db.OpenRecordset(psTablename, dbOpenDynaset)

   Set rsFilename = db.OpenRecordset("c_AttLinks", dbOpenDynaset)

   Do While Not rs.EOF
      nRecordID = rs(psFld_ID).Value

      Set rs2 = rs.Fields(psFld_Attachment).Value

      nAttLinkID = -99


      Do While Not rs2.EOF

         sFilename = rs2.Fields("FileName").Value

         'see if fiilename is already in attachment directory
         With rsFilename
            .FindFirst "AttLink=""" & sFilename & """"
            If Not .NoMatch Then
               If MsgBox(sFilename & " is already in the Attachments Directory" _
                     & vbCrLf & vbCrLf & "YES = Use the existing attachment for record " & nRecordID _
                     & vbCrLf & " No = make a new filename for the attachment" _
                     , vbYesNoCancel, "Is Same File linked to another record") = vbYes Then
                  nAttLinkID = !AttLinkID
               Else
                  'constuct different filename
                  iPos = InStrRev(sFilename, ".")

                  sFileExtension = Mid(sFilename, iPos)
                  sFilename = Left(sFilename, iPos - 1)

                  sFilename = sFilename & "_" & psTablename & "_" & nRecordID & sFileExtension

                  sPathFile = psPathAttachments & sFilename

                  If Len(Dir(sPathFile)) > 0 Then
                     ' set attribute to Normal in case it is ReadOnly
                     ' VBA.SetAttr sPathFile, vbNormal

                     If MsgBox("You already have this file attached -- do you want to replace it?" _
                           , vbYesNo, "Replace attachment for record " & nRecordID & "?") <> vbYes Then
                        GoTo NextAttachment
                     End If

                     'could compare file sizes, modification dates, ...
                     '-- this may not be what you want to do ... maybe rename: x_ filename
                     Kill sPathFile
                     DoEvents
                     DoEvents
                     DoEvents
                  End If
               End If
            Else
               'file is not in Attachments directory yet
               iPos = InStrRev(sFilename, ".")
               sFileExtension = Mid(sFilename, iPos)
               sPathFile = psPathAttachments & sFilename
            End If

            If nAttLinkID = -99 Then


               .AddNew
               !AttLink = sFilename
               !DocExt = sFileExtension
               Select Case sFileExtension
               Case ".jpg", "png", ".bmp"
                  !AttTypID = 2 'image file
               Case Else
                  !AttTypID = 1 'file
               End Select
               .Update
               .Bookmark = .LastModified
               nAttLinkID = !AttLinkID
            End If
         End With 'rsFilename


         Set fld2 = rs2.Fields("FileData")
         fld2.SaveToFile sPathFile
         nNumFilesCreated = nNumFilesCreated + 1

         sSQL = "INSERT INTO c_Attachments " _
            & "(TID, RecordID, AttLinkID, AttName)" _
            & " SELECT " & pnTID _
            & ", " & nRecordID _
            & ", " & nAttLinkID _
            & ", """ & sFilename & """" _
            & ";"

         With db
            Debug.Print sSQL
           .Execute sSQL
           Debug.Print "------------ " & .RecordsAffected
           If Not .RecordsAffected > 0 Then
              If MsgBox("Error creating Attachment Record for " _
                 & sPathFile, vbOKCancel, "Error -- continue anyway") = vbCancel Then
                    GoTo Proc_Exit
              End If
           End If
         End With

NextAttachment:
         rs2.MoveNext
      Loop 'rs2
      rs2.Close

      rs.MoveNext
   Loop 'rs

   MsgBox "Created " & nNumFilesCreated & " Files from Attachments" _
      , , "Done"

Proc_Exit:
   On Error Resume Next
   'release object variables
   Set fld2 = Nothing
   If Not rs Is Nothing Then
      rs.Close
      Set rs = Nothing
   End If
   If Not rsFilename Is Nothing Then
      rsFilename.Close
      Set rsFilename = 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

Learn Access Playlist on YouTube
http://www.youtube.com/view_play_list?p=1B2705CCB40CA4CA


			Learn Access By Crystal - YouTube The "Learn Access" series takes an idea from concept to application. First is planning -- do not neglect this important step. http://www.youtube.com/playlist...
			View on www.youtube.com	Preview by Yahoo

(: have an awesome day :)

On Wednesday, May 28, 2014 4:29 PM, "Peter Poppe plpoppe@gmail.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:

That is correct you are limited to 2G. Attachments do not bloat the database like the older methods, but they will increase the size of the database proportionally to the size of the document. So if you have 2gigs of documents then it will get near 2 gigs. Those are pretty big documents if 72 are getting near 2 gigs. See what happens if you compact and repair the database. Make a copy first. So my question is do you want to redesign this so that in the future when you add a document it automatically stores the timestamp? This will take some work. But, I can give you the code so that it will automatically move the documents. Or do you just want to bandaid a fix for the current documents? I will assume you will have to backdate the "timestamp" for the existing documents. You could do that without much redesign, but would require some manual effort.

If you think you are going to be adding beyond 2 gigs of documents, then it is time to extract the documents and put them on a folder on the system (preferably a network folder). Instead of storing them in the database, you will just maintain the path to the document.

Is this something where you are adding documents often? I would look at the redesign if you really need that time stamp. If this is something where you very rarely make updates/additions then you may want to go the easier but more manual approach.

On Wed, May 28, 2014 at 5:53 PM, ka0t1c_ang3l <no_reply@yahoogroups.com> wrote:

Another question, I read someplace that a database cannot be bigger than 2GB, is that correct? If so, then this database is quickly approaching the 2GB mark, and I'm sure it's because the attachments are stored in the database.