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.

Code:

---

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

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?

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

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.

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

Try
msgbox fld.value

Here is what came up.

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?

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.

Code:

---

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:

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

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.

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?

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:

Code:

---

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.