Solved Payin' Cost for using Attachment - Round 2 (1 Viewer)

gakiss2

Registered User.
Local time
Yesterday, 23:43
Joined
Nov 21, 2018
Messages
150
I've made a lot of progress with pulling attachments out and saving them in the newly revised database that uses the 'old fashioned' method of saving the files in a folder on the server then saving the file path in the database so users can still easily get to the files but the files don't live in your database, making it HUGE. We busted the 2G limit in less than two years.

Most of the code to allow users to pick files using the 'MSO' function I found on the internet, and didn't do a great job of giving credit. But since then I have integrated that into the working database. Recently launched the upgrades and all that seems to be working great.

Now I am working on a procedure to move through all of the previously entered records, pull out the attachments, save them to the approp. folder (by supplier name) then save the filepath. The goal is for the user to pull up an old record and have the files that he/she previously attached to the database now show up in the list of saved files that are available.

Actually I am most of the way there. I have the written the below code and gotten it to do everything perfectly for the first record in The Table. The Table is the main table that contains the records which currently have attachments saved in them, it is named tblDocsIssued. The table that holds the file path is tblAttachmentPaths.
Now I need to get the procedure to move through the records one by one and complete the steps mentioned. When I step through it, I can see each record being selected one after the other but the code only operates on the first record in the table over and over. Part of the procedure is to delete the attachments after they are moved to the proper folder and the file path saved. this causes the procedure to do nothing after the first go 'round. this is as it should be since it loops through the attachments until end of file.

As you might imagine, if I delete the first record of the table then the next time I run it, it starts on the new first record. I just did that to confirm. I can't do that for real since I want to maintain these records, just without those pesky attachments.
Code:
Private Sub transfer()

' Code to Save Attachment files in designated folder and save path in new Db
' Instantiate the parent recordset.
' sFolder = "C:\Users\gakis\Desktop\Attachments\" & SupFolder & "\QDAttach\"
Dim rsAttachs As Recordset
Dim i As Double
Dim db As Database
Set db = CurrentDb
Dim rsDocs As Recordset
' findstr = Me.NewLBTrackNo
Dim strFile As String

DoCmd.OpenTable "tblDocsIssued"
For i = 1 To 3
DoCmd.GoToRecord acDataTable, "tblDocsIssued", acNext

Set rsAttachs = db.OpenRecordset("tblDocsIssued")

    ' Get Supplier Folder
    ' SupFolder = Tables("tblDocsIssued").AssignedVendor   ' Didn't work  trying dlookup next
    Dim SupFolder As Variant
    SupFolder = DLookup("[AssignedVendor]", _
    "tblDocsIssued")
    
    Dim NewLBNo As String
    NewLBNo = DLookup("[NewLBTrackNo]", "tblDocsIssued")
    Debug.Print "Doc Number " & NewLBNo
    
    
    Debug.Print "vendor " & SupFolder
    ' Check if folder exists
    chkFolder = "C:\Users\gakis\Desktop\Attachments\" & SupFolder & "\QDAttach\"
        If Dir(chkFolder, vbDirectory) = vbNullString Then
            MsgBox "Supplier Folder does not exist"
            Exit Sub
        End If
    
' Instantiate the child recordset.
Set rsDocs = rsAttachs.Fields("Document").Value
   '  Loop through the attachments.
While Not rsDocs.EOF
    ' Code to capture filename of attachment
    strFile = "C:\Users\gakis\Desktop\Attachments\" _
        & SupFolder & "\QDAttach\" & rsDocs![FileName]
    Debug.Print "file " & strFile
      '  Save current attachment to disk in correct supplier folder.
    rsDocs.Fields("FileData").SaveToFile "C:\Users\gakis\Desktop\Attachments\" _
        & SupFolder & "\QDAttach\"
 
    ' Save the path to the attachment path table
    ' Original Code:  If CopyFile(sFile, sFolder & GetFileName(sFile)) = True Then
    'Commenting out IF Then logic rsDocs gets error that its wrong type, makes sense but how to fix??
    'If CopyFile(rsDocs, chkFolder & GetFileName(rsDocs)) = True Then
            
            ' Append FullFileName to tblAttachmentPaths
            DoCmd.SetWarnings False
            
            ' Code to Delete the attachments from the Table
             rsDocs.Delete
            DoCmd.RunSQL "INSERT INTO tblAttachmentPaths (FullFileName, LBTrackNo) " _
                & vbCrLf & "VALUES('" & strFile & "','" & NewLBNo & "')"
            DoCmd.SetWarnings True
                
        'Else
            ' MsgBox "HI 'Probably should report something here about the File Copy failing"
        'End If
 
     rsDocs.MoveNext
Wend
  
Next i    ' next record

End Sub
Any and all help appreciated.
 

Gasman

Enthusiastic Amateur
Local time
Today, 07:43
Joined
Sep 21, 2011
Messages
5,984
I believe it is because you keep openng recordset rsAttachs and are using that to get the attachments?
I would normally use .MoveNext withing a recordset.?

What is the significance of i = 1 to 3 ?

As always. walk through your code with F8, that should confirm it.?
 

gakiss2

Registered User.
Local time
Yesterday, 23:43
Joined
Nov 21, 2018
Messages
150
I believe it is because you keep openng recordset rsAttachs and are using that to get the attachments?
I would normally use .MoveNext withing a recordset.?

What is the significance of i = 1 to 3 ?

As always. walk through your code with F8, that should confirm it.?
1 to 3 is just a cautious beginning. After I am confident its working right I'll go through the entire table. The idea is to get rid of all the attachments so I can shrink the size.

walking through with F8, I can see the next record getting 'selected' then the next, then the next. but the code keeps operating on the first record.

"DoCmd.GoToRecord acDataTable, "tblDocsIssued", acNext " was supposed to move me from record to record and maybe that is what is making the selection move from record to record but what I wanted is for the 'procedure' to move to the next record in the table, operate on that then the next and etc.

There is a .MoveNext just before WEND. I think that moves from attachment to attachment until EOF.

Maybe another .MoveNext after that loop??
 

gakiss2

Registered User.
Local time
Yesterday, 23:43
Joined
Nov 21, 2018
Messages
150
I guess I don't understand where to put .MoveNext. I tried it but the procedure behaves the same.
Code:
Private Sub transfer()

' Code to Save Attachment files in designated folder and save path in new Db
' Instantiate the parent recordset.
' sFolder = "C:\Users\gakis\Desktop\Attachments\" & SupFolder & "\QDAttach\"
Dim rsAttachs As Recordset
Dim i As Double
Dim db As Database
Set db = CurrentDb
Dim rsDocs As Recordset
' findstr = Me.NewLBTrackNo
Dim strFile As String

DoCmd.OpenTable "tblDocsIssued"
Set rsAttachs = db.OpenRecordset("tblDocsIssued")
For i = 1 To 3
' DoCmd.GoToRecord acDataTable, "tblDocsIssued", acNext



    ' Get Supplier Folder
    ' SupFolder = Tables("tblDocsIssued").AssignedVendor   ' Didn't work  trying dlookup next
    Dim SupFolder As Variant
    SupFolder = DLookup("[AssignedVendor]", _
    "tblDocsIssued")
    
    Dim NewLBNo As String
    NewLBNo = DLookup("[NewLBTrackNo]", "tblDocsIssued")
    Debug.Print "Doc Number " & NewLBNo
    
    
    Debug.Print "vendor " & SupFolder
    ' Check if folder exists
    chkFolder = "C:\Users\gakis\Desktop\Attachments\" & SupFolder & "\QDAttach\"
        If Dir(chkFolder, vbDirectory) = vbNullString Then
            MsgBox "Supplier Folder does not exist"
            Exit Sub
        End If
    
' Instantiate the child recordset.
Set rsDocs = rsAttachs.Fields("Document").Value
   '  Loop through the attachments.
While Not rsDocs.EOF
    ' Code to capture filename of attachment
    strFile = "C:\Users\gakis\Desktop\Attachments\" _
        & SupFolder & "\QDAttach\" & rsDocs![FileName]
    Debug.Print "file " & strFile
      '  Save current attachment to disk in correct supplier folder.
    rsDocs.Fields("FileData").SaveToFile "C:\Users\gakis\Desktop\Attachments\" _
        & SupFolder & "\QDAttach\"
 
    ' Save the path to the attachment path table
    ' Original Code:  If CopyFile(sFile, sFolder & GetFileName(sFile)) = True Then
    'Commenting out IF Then logic rsDocs gets error that its wrong type, makes sense but how to fix??
    'If CopyFile(rsDocs, chkFolder & GetFileName(rsDocs)) = True Then
            
            ' Append FullFileName to tblAttachmentPaths
            DoCmd.SetWarnings False
            
            ' Code to Delete the attachments from the Table
             rsDocs.Delete
            DoCmd.RunSQL "INSERT INTO tblAttachmentPaths (FullFileName, LBTrackNo) " _
                & vbCrLf & "VALUES('" & strFile & "','" & NewLBNo & "')"
            DoCmd.SetWarnings True
                
        'Else
            ' MsgBox "HI 'Probably should report something here about the File Copy failing"
        'End If
 
     rsDocs.MoveNext
Wend
     rsAttachs.MoveNext
Next i    ' next record

End Sub
 

Cronk

Registered User.
Local time
Today, 16:43
Joined
Jul 4, 2013
Messages
2,382
rsAttachs.MoveNext
is in the right place.

Are you sure you are not progressing to the next record in rsAttachs? Put a debug.print rsAttachs!Keyfield but replace Keyfield with whatever your field is named.
 

CJ_London

Super Moderator
Staff member
Local time
Today, 07:43
Joined
Feb 19, 2013
Messages
12,128
haven't followed the code in full but suggest comment out your rsDocs.Delete line and see what happens. Reason is, when you delete, the focus is moved to the previous record. Usual way when doing deletes is to start at the last record and moveprevious rather than starting at the first and movenext.
 

June7

AWF VIP
Local time
Yesterday, 22:43
Joined
Mar 9, 2014
Messages
3,108
Why bother deleting attachment record? Do the export then when all looks good, just delete the field from table.
 

Gasman

Enthusiastic Amateur
Local time
Today, 07:43
Joined
Sep 21, 2011
Messages
5,984
1 to 3 is just a cautious beginning. After I am confident its working right I'll go through the entire table. The idea is to get rid of all the attachments so I can shrink the size.

walking through with F8, I can see the next record getting 'selected' then the next, then the next. but the code keeps operating on the first record.

"DoCmd.GoToRecord acDataTable, "tblDocsIssued", acNext " was supposed to move me from record to record and maybe that is what is making the selection move from record to record but what I wanted is for the 'procedure' to move to the next record in the table, operate on that then the next and etc.

There is a .MoveNext just before WEND. I think that moves from attachment to attachment until EOF.

Maybe another .MoveNext after that loop??
I would understand that, but you then open recordset rsAttachs, so would be at the first record.?

Either open the table or the recordset, not both. I've always used a recordset, but it is your choice.
You appear to use table fields to get vendor etc and then use rsAttachs to get the attachments in to recordset rsDocs.

I'd also go with June7's decision, just delete the field when you are *absolutely* sure all is working correctly. Someone else was also trying to do this so you could search Similar Threads, but I think you are almost there.?

So my approach would be use recordset rsAttach only and .MoveNext

Try this
HTH

Rich (BB code):
Sub SaveAttachments()
Dim i As Double
Dim db As Database
Set db = CurrentDb
Dim rsDocs As Recordset
' findstr = Me.NewLBTrackNo
Dim strFile As String

'DoCmd.OpenTable "tblDocsIssued"
'For i = 1 To 3
'DoCmd.GoToRecord acDataTable, "tblDocsIssued", acNext

Set rsAttachs = db.OpenRecordset("tblDocsIssued")
For i = 1 To 3

    ' Get Supplier Folder
    ' SupFolder = Tables("tblDocsIssued").AssignedVendor   ' Didn't work  trying dlookup next
    Dim SupFolder As Variant
    SupFolder = Dlookup("[AssignedVendor]", _
    "tblDocsIssued")
    
    Dim NewLBNo As String
    NewLBNo = Dlookup("[NewLBTrackNo]", "tblDocsIssued")
    Debug.Print "Doc Number " & NewLBNo
    
    
    Debug.Print rsAttach!vendor & " " & SupFolder
    ' Check if folder exists
    chkFolder = "C:\Users\gakis\Desktop\Attachments\" & SupFolder & "\QDAttach\"
        If Dir(chkFolder, vbDirectory) = vbNullString Then
            'MsgBox "Supplier Folder does not exist"
            'Exit Sub
            MkDir chkFolder
        End If
    
' Instantiate the child recordset.
Set rsDocs = rsAttachs.Fields("Document").Value
   '  Loop through the attachments.
While Not rsDocs.EOF
    ' Code to capture filename of attachment
    strFile = "C:\Users\gakis\Desktop\Attachments\" _
        & SupFolder & "\QDAttach\" & rsDocs![FileName]
    Debug.Print "file " & strFile
      '  Save current attachment to disk in correct supplier folder.
    rsDocs.Fields("FileData").SaveToFile "C:\Users\gakis\Desktop\Attachments\" _
        & SupFolder & "\QDAttach\"
 
    ' Save the path to the attachment path table
    ' Original Code:  If CopyFile(sFile, sFolder & GetFileName(sFile)) = True Then
    'Commenting out IF Then logic rsDocs gets error that its wrong type, makes sense but how to fix??
    'If CopyFile(rsDocs, chkFolder & GetFileName(rsDocs)) = True Then
            
            ' Append FullFileName to tblAttachmentPaths
            DoCmd.SetWarnings False
            
            ' Code to Delete the attachments from the Table
             'rsDocs.Delete
            DoCmd.RunSQL "INSERT INTO tblAttachmentPaths (FullFileName, LBTrackNo) " _
                & vbCrLf & "VALUES('" & strFile & "','" & NewLBNo & "')"
            DoCmd.SetWarnings True
                
        'Else
            ' MsgBox "HI 'Probably should report something here about the File Copy failing"
        'End If
 
     rsDocs.MoveNext
Wend
rsAttachs.MoveNext
  
Next i    ' next record

Set rsAttachs = Nothing
Set rsDocs = Nothing
Set db = Nothing
End Sub
 

gakiss2

Registered User.
Local time
Yesterday, 23:43
Joined
Nov 21, 2018
Messages
150
I would understand that, but you then open recordset rsAttachs, so would be at the first record.?

Either open the table or the recordset, not both. I've always used a recordset, but it is your choice.
You appear to use table fields to get vendor etc and then use rsAttachs to get the attachments in to recordset rsDocs.

I'd also go with June7's decision, just delete the field when you are *absolutely* sure all is working correctly. Someone else was also trying to do this so you could search Similar Threads, but I think you are almost there.?

So my approach would be use recordset rsAttach only and .MoveNext

Try this
HTH

Rich (BB code):
Sub SaveAttachments()
Dim i As Double
Dim db As Database
Set db = CurrentDb
Dim rsDocs As Recordset
' findstr = Me.NewLBTrackNo
Dim strFile As String

'DoCmd.OpenTable "tblDocsIssued"
'For i = 1 To 3
'DoCmd.GoToRecord acDataTable, "tblDocsIssued", acNext

Set rsAttachs = db.OpenRecordset("tblDocsIssued")
For i = 1 To 3

    ' Get Supplier Folder
    ' SupFolder = Tables("tblDocsIssued").AssignedVendor   ' Didn't work  trying dlookup next
    Dim SupFolder As Variant
    SupFolder = Dlookup("[AssignedVendor]", _
    "tblDocsIssued")
   
    Dim NewLBNo As String
    NewLBNo = Dlookup("[NewLBTrackNo]", "tblDocsIssued")
    Debug.Print "Doc Number " & NewLBNo
   
   
    Debug.Print rsAttach!vendor & " " & SupFolder
    ' Check if folder exists
    chkFolder = "C:\Users\gakis\Desktop\Attachments\" & SupFolder & "\QDAttach\"
        If Dir(chkFolder, vbDirectory) = vbNullString Then
            'MsgBox "Supplier Folder does not exist"
            'Exit Sub
            MkDir chkFolder
        End If
   
' Instantiate the child recordset.
Set rsDocs = rsAttachs.Fields("Document").Value
   '  Loop through the attachments.
While Not rsDocs.EOF
    ' Code to capture filename of attachment
    strFile = "C:\Users\gakis\Desktop\Attachments\" _
        & SupFolder & "\QDAttach\" & rsDocs![FileName]
    Debug.Print "file " & strFile
      '  Save current attachment to disk in correct supplier folder.
    rsDocs.Fields("FileData").SaveToFile "C:\Users\gakis\Desktop\Attachments\" _
        & SupFolder & "\QDAttach\"

    ' Save the path to the attachment path table
    ' Original Code:  If CopyFile(sFile, sFolder & GetFileName(sFile)) = True Then
    'Commenting out IF Then logic rsDocs gets error that its wrong type, makes sense but how to fix??
    'If CopyFile(rsDocs, chkFolder & GetFileName(rsDocs)) = True Then
           
            ' Append FullFileName to tblAttachmentPaths
            DoCmd.SetWarnings False
           
            ' Code to Delete the attachments from the Table
             'rsDocs.Delete
            DoCmd.RunSQL "INSERT INTO tblAttachmentPaths (FullFileName, LBTrackNo) " _
                & vbCrLf & "VALUES('" & strFile & "','" & NewLBNo & "')"
            DoCmd.SetWarnings True
               
        'Else
            ' MsgBox "HI 'Probably should report something here about the File Copy failing"
        'End If

     rsDocs.MoveNext
Wend
rsAttachs.MoveNext
 
Next i    ' next record

Set rsAttachs = Nothing
Set rsDocs = Nothing
Set db = Nothing
End Sub
I got it figured out before I saw your code but you had the right idea. This is my first dance with Recordset so I didn't understand them. Although I don't claim to fully understand them now, my understanding was at least expanded this time around. I learned how to pull the SupplierFolder and the NewLBTrackNo using a recordset command instead of DLookup. I was able to keep the .Delete line. I suppose that is more about convenience although it really wouldn't have taken much effort to delete them afterword. I did end up moving the rsAttachs.MoveNext to the front of the loop. I'm not sure why that made a difference but sometimes when it works, you just accept it. I don't understand what the …. = Nothing section accomplishes. Should go ahead and add it given that everything is working?
 

Gasman

Enthusiastic Amateur
Local time
Today, 07:43
Joined
Sep 21, 2011
Messages
5,984
Movenext should always be at the end of the loop?, otherwise you would skip the first record?
I would expect that you would be using vendor etc from each record, but you were also using the same one?, no criteria used in the DlookUps

The = Nothing clears the objects set in the code. Some say not needed, but in this I like to be tidy and make sure. Up to you. It does not hurt, that is the main thing. I would also question the order for delete as mentioned. much safer to delete the field from the table at the end of all this, or MoveLast, then MovePrevious until BOF.

Good luck anyway.
 
Last edited:

gakiss2

Registered User.
Local time
Yesterday, 23:43
Joined
Nov 21, 2018
Messages
150

gakiss2

Registered User.
Local time
Yesterday, 23:43
Joined
Nov 21, 2018
Messages
150
Movenext should always be at the end of the loop?, otherwise you would skip the first record?
I would expect that you would be using vendor etc from each record, but you were also using the same one?, no criteria used in the DlookUps

The = Nothing clears the objects set in the code. Some say not needed, but in this I like to be tiday and make sure. Up to you. It does not hurt, that is the main thing. I would also question the order for delete as mentioned. much safer to delete the field from the table at the end of all this, or MoveLat, then MovePrevious until BOF.

Good luck anyway.
Yes it does skip the first record, got lucky as it didn't have an attachment. I do understand some of what went wrong with using DLookup. Ultimately it was the wrong tool for the job anyway. Thanks for all your help.
 

Gasman

Enthusiastic Amateur
Local time
Today, 07:43
Joined
Sep 21, 2011
Messages
5,984
Thank You. I got it working. Now philosophizing: If you took all the 'work' we supposedly 'saved' using MS Access Attachment field and doubled and doubled and doubled it, it doesn't feel like that would come close to the work I had to do to get us out from under the all the problems those attachments caused. I am relieved for now, until it crashes again. ;)
Think of it as 'Preventative Maintenance' :D
 

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

Top Bottom