Consulting

Results 1 to 13 of 13

Thread: Increment file name by 1 VBA

  1. #1
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location

    Increment file name by 1 VBA

    Hello,

    I have found a code that saves all attachments in a table called "attachments" to a folder. I have modified it and got it to work, but the problem I have now is incrementing the file name by one every time a file name already exist. Below is the code I have.
    Private Sub Command38_Click()
    
            Dim dbs As DAO.Database
            Dim rst As DAO.Recordset2
            Dim rsA As DAO.Recordset2
            Dim fld As DAO.Field2
            Dim strPath As String
            Dim strFullPath As String
            Dim strPattern As String
            strPattern = "*.*"
            On Error GoTo ErrorHandel
                  
            
            'Get the database, recordset, and attachment field
            Set dbs = CurrentDb
            Set rst = dbs.OpenRecordset("Attachments")
            Set fld = rst("Field1")
            
            'Navigate through the table
            Do While Not rst.EOF
            
                'Get the recordset for the Attachments field
                Set rsA = fld.Value
                
                'Save all attachments in the field
                Do While Not rsA.EOF
                    If rsA("FileName") Like strPattern Then
                        strFullPath = "I:\HumRes\FP\Communication\Attachment" & "\" & rsA("FileName")
                        
                        'Make sure the file does not exist and save
                        If Dir(strFullPath) = "" Then
                            rsA("FileData").SaveToFile strFullPath
                            
                            Else
                            'Increment the number of files saved
                         fld.Value = fld.Value + 1
                         
                         rsA("FileData").SaveToFile strFullPath
    
    
                           
                        End If
                        
                        
                        
                    End If
                    
                    'Next attachment
                    rsA.MoveNext
                Loop
                rsA.Close
                
                'Next record
                rst.MoveNext
            Loop
    ErrorHandel:
          MsgBox "Error: (" & Err.Number & ") " & Err.Description, vbCritical
          
            rst.Close
            dbs.Close
            
    
          
            
            Set fld = Nothing
            Set rsA = Nothing
            Set rst = Nothing
            Set dbs = Nothing
    End Sub
    I have looked around and tried different things but VBA is not a strong suit for me. The goal of this code is to save all attachments in the table to folder.

    Thank You for any info/help on this,
    KDC900

  2. #2
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Can you tell me what the actual values or data is in the field1 in the rst recordset you are working through?
    Also where does the "filename" in RSA("filename") come from?

  3. #3
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location
    Hello OBP,

    Field1 is an attachment field.
    As far as "FileName" and "FileData", they are 2 out of the 3 values that make up the multivalue attachment field or at least that's what it looked like when I researched it.

    Thank you,
    KDC900

  4. #4
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Unfortunately I am not familiar with attachment fields.
    After the
    Set fld = rst("field1")
    can you enter the code
    msgbox fld
    and post the result on here so that I can see what the variable fld holds.
    The next question is will the "other" same attachments be in the same record or subsequent records?
    If so then you should create a table that stores the file names in use to make it easy to test if they are already used and what the last incremented name was.

  5. #5
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location
    Hello OBP,

    when I run the code with "msgbox fld" I get Error (13) type mismatch. as far a table for attachments, currently all attachments are saved in a separate table just for them.

    Thank You,
    KDC900

  6. #6
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Try
    msgbox fld.value

  7. #7
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location
    Here is what came up.
    Attached Images Attached Images

  8. #8
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Well that doesn't mean anything to me, does it to you?
    You said in your opening comment that the code works, what filename does it create?

  9. #9
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location
    The attachments name and .msg is what appears in the designated folder. Its manly if not all email attachments also I have never seen that symbol before. I have tried adding in to the code to where is adds a random number to the rsA(FileName) if a file exists.
    Private Sub Command38_Click()
    
            Dim dbs As DAO.Database
            Dim rst As DAO.Recordset2
            Dim rsA As DAO.Recordset2
            Dim fld As DAO.Field2
            Dim strPath As String
            Dim strFullPath As String
            Dim strPattern As String
            strPattern = "*.*"
            On Error GoTo ErrorHandel
                  
            
            'Get the database, recordset, and attachment field
            Set dbs = CurrentDb
            Set rst = dbs.OpenRecordset("Attachments")
            Set fld = rst("Field1")
           
            
            'Navigate through the table
            Do While Not rst.EOF
            
                'Get the recordset for the Attachments field
                Set rsA = fld.Value
     
                'Save all attachments in the field
                Do While Not rsA.EOF
                    If rsA("FileName") Like strPattern Then
                        strFullPath = "I:\HRes\FPAY\Communication\Attachment" & "\" & rsA("FileName")
                        
                        'Make sure the file does not exist and save
                        If Dir(strFullPath) = "" Then
                            rsA("FileData").SaveToFile strFullPath
                            
                        Else
                       rsA("FileName") = rsA("FileName") & Rnd
                       strFullPath = "I:\HRes\FPAY\Communication\Attachment" & "\" & rsA("FileName")
                       rsA("FileData").SaveToFile strFullPath
                       
                        End If
                        
              
                    End If
                    
                    'Next attachment
                    rsA.MoveNext
                Loop
                rsA.Close
                
                'Next record
                rst.MoveNext
            Loop
    ErrorHandel:
          MsgBox "Error: (" & Err.Number & ") " & Err.Description, vbCritical
          
            rst.Close
            dbs.Close
            
    
          
            
            Set fld = Nothing
            Set rsA = Nothing
            Set rst = Nothing
            Set dbs = Nothing
    End Sub
    But I now get this error:
    Attached Images Attached Images

  10. #10
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Do you know which line of code gives the error?
    I use simple msgboxes in the code to test where it occurs ie
    msgbox 0
    msgbox 1
    msgbox 2
    in strategic places in the code

  11. #11
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location
    The error occurs where is says

    Else
    rsA("FileName") = rsA("FileName") & Rnd

    as soon as it hit the else it popped the Error message mentioned before.

  12. #12
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Rnd is the reserved word for the Random Function and it has it's own syntax see
    https://support.office.com/en-us/art...A-ED8FB35C1D80

    Are actually trying to use a Random number rather than an actual value?

  13. #13
    VBAX Regular
    Joined
    Dec 2017
    Posts
    43
    Location
    Hello OBP,

    it was a thought that went though my head in the hopes of it working. I did modify my code and so far I think it is doing what I want. see below:
    Dim dbs As DAO.Database
            Dim rst As DAO.Recordset2
            Dim rsA As DAO.Recordset2
            Dim fld As DAO.Field2
            Dim strPath As String
            Dim strFullPath As String
            Dim strPattern As String
            strPattern = "*.*"
            On Error GoTo ErrorHandel
                  
            
            'Get the database, recordset, and attachment field
            Set dbs = CurrentDb
            Set rst = dbs.OpenRecordset("Attachments")
            Set fld = rst("Field1")
           
            
            'Navigate through the table
            Do While Not rst.EOF
            
                'Get the recordset for the Attachments field
                Set rsA = fld.Value
     
                'Save all attachments in the field
                Do While Not rsA.EOF
                    If rsA("FileName") Like strPattern Then
                        strFullPath = "I:\HRes\FPAY\Communication\Attachment" & "\" & Rnd & rsA("FileName")
                        
                        'Make sure the file does not exist and save
                        If Dir(strFullPath) = "" Then
                            rsA("FileData").SaveToFile strFullPath
                            
                       
                        End If
                        
              
                    End If
                    
                    'Next attachment
                    rsA.MoveNext
                Loop
                rsA.Close
                
                'Next record
                rst.MoveNext
            Loop
    ErrorHandel:
          MsgBox "Error: (" & Err.Number & ") " & Err.Description, vbCritical
          
            rst.Close
            dbs.Close
            
          
            
            Set fld = Nothing
            Set rsA = Nothing
            Set rst = Nothing
            Set dbs = Nothing
    End Sub
    in stead of having vba look to see if a file name exists and the adding a number I just had the name already start off with a random number. Example ".001 filename.msg". I am checking to see if all were copied out.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •