Solved Exporting Image Files from Table - Having File Naming Issues

[UnionWarDog]

Hi guys!

I'm trying to export attachments from my table and relabel the file as the name from a column from the table [UnitCard]. Currently it exports them as the name of the attachment.

Here are the column names:

LeadersDBList

ID	STATE	Size	Utype	GenSide	NationFolder	Unit Name	UnitCard	Image	GenImage
1	Bulgarian	Department	Leader	Rebel Genearl	Bulgarian	Department Nr. 2	Gen Albert S. Johnston	BitmapImage	@(1)

It currently extracts the file from GenImage as "GenHQ.bmp" but I want it to use the name from UnitCard and export the file as "Gen Albert S. Johnston.bmp"

Currently there are 251 lines in my table. Here is the module script I'm using to export the files.

Public Sub ExtractAllAttachments(ByVal TableName As String, ByVal AttachmentColumnName As String, ByVal ToDirectory)


    Dim rsMainRecords As DAO.Recordset2
    Dim rsAttachments As DAO.Recordset2
  
    Set rsMainRecords = CurrentDb.OpenRecordset("SELECT " & AttachmentColumnName & _
                                                 " FROM " & TableName & _
                                                 " WHERE " & AttachmentColumnName & ".FileName IS NOT NULL")
                                               
    Do Until rsMainRecords.EOF
      
        Set rsAttachments = rsMainRecords.Fields(AttachmentColumnName).Value
      
        Do Until rsAttachments.EOF
          
            Dim outputFileName As String
          
            outputFileName = rsAttachments.Fields("FileName").Value
            outputFileName = ToDirectory & "\" & outputFileName
          
            rsAttachments.Fields("FileData").SaveToFile outputFileName
          
          
            rsAttachments.MoveNext
        Loop
        rsAttachments.Close
  
        rsMainRecords.MoveNext
    Loop
  
    rsMainRecords.Close
  
    Set rsAttachments = Nothing
    Set rsMainRecords = Nothing

End Sub

Immediate:
ExtractAllAttachments "LeadersDBList","GenImage","E:\TempImages"

 

[theDBguy]

Check your records to make sure they don't contain any illegal characters for filenames.

 

[GaP42]

You can run a routine to cleanse the Unit name of any illegal characters before assigning the file name. Adjust as needed.

Public Function fStripIllegal(strCheck As String, Optional strReplaceWith As String = "") As String

' PURPOSE: Strips illegal characters from a string that is to be used as a filename or foldername
' NOTES:
'   Function can be used to sanitize strings for other purposes, configured and named to suit.
'   Default function strips out spaces too.
'   One replacement character can be specified for any illegal char occurrence if needed

'   The illegal filename / foldername characters included in default string are
'       ? [ ] /  = + < > : ; , * " ' CR, LF
'    chr(34) = ", chr(39) = ', chr(13) = CR, chr(10) = LF
'    ** Chr(32) = space  - may be added to ensure spaces within the string are removed/replaced
'    ** TRIM function is used to remove leading and trailing spaces in all cases - no substitution

    On Error GoTo StripIllErr
    
    Dim intI             As Integer
    Dim intPassedString  As Integer
    Dim intCheckString   As Integer
    Dim strChar          As String
    Dim strIllegalChars  As String
    Dim intReplaceLen    As Integer
    
'    strCheck = Trim(strCheck)  ' to remove any leading or trailing spaces in the supplied string (no substitution)
'    The last step of the function applies Trim to the strCheck.
'    If Chr(32) is in strIllegalChars, then spaces in the string may be substituted before removal by Trim
'    Uncomment above Trim statement to apply before any other action, if needed

    If IsNull(strCheck) Then Exit Function
    
    ' add/remove characters to be stripped from the string
    strIllegalChars = "?[]/=+<>:;,*" & Chr(34) & Chr(39) & Chr(13) & Chr(10) & Chr(32)
    intPassedString = Len(strCheck)
    intCheckString = Len(strIllegalChars)

    intReplaceLen = Len(strReplaceWith)

    If intReplaceLen > 0 Then        ' a character has been entered to use as the replacement character

        If intReplaceLen = 1 Then    ' check the character itself isn't an illegal character
            If InStr(strIllegalChars, strReplaceWith) > 0 Then
                MsgBox "You can't replace an illegal character with another illegal character", _
                       vbOKOnly vbExclamation, "Invalid Character"
                fStripIllegal = strCheck
                Exit Function
            End If
        Else        'only one replacement character allowed
            MsgBox "Only one character is allowed as a replacement character", _
                   vbOKOnly vbExclamation, "Invalid Replacement String"
            fStripIllegal = strCheck
            Exit Function
        End If
        
    End If

    If intPassedString < intCheckString Then

        For intI = 1 To intCheckString
            strChar = Mid(strIllegalChars, intI, 1)
            If InStr(strCheck, strChar) > 0 Then
                strCheck = Replace(strCheck, strChar, strReplaceWith)
            End If
        Next intI
    Else
        For intI = 1 To intPassedString
            strChar = Mid(strIllegalChars, intI, 1)
            If InStr(strCheck, strChar) > 0 Then
                strCheck = Replace(strCheck, strChar, strReplaceWith)
            End If
        Next intI

    End If
    
    If Len(strCheck) = 0 Then
    ' the name was composed of only illegal chars
        MsgBox "The name of the person selected contains no legal characters- the process could not be completed", vbInformation
        GoTo StripIllExit
    End If

    fStripIllegal = Trim(strCheck)
    
    fStripIllegal = strCheck

StripIllExit:
    Exit Function

 

[Gasman]

Walk your code and see what values you actually have, especially when you have errors.
Set an error routine in your code.

Also please use code tags when you post any code. The </> icon.

 

[UnionWarDog]

Thanks for the quick feedback guys! Much appreciated!. The key issue isn't being able to extract the attachment file. The issue is I want to rename the file as the name of column [Unitcard]. Currently it exports it and names the file as the original attachment name. I'm not sure how to change the script to re-name the file as the line in the column Unitcard. Here is the current section:

Dim outputFileName As String

outputFileName = rsAttachments.Fields("FileName").Value (I need it to be something like rsUnitcard.Fields("FileName").Value...I think ?)
outputFileName = ToDirectory & "\" & outputFileName

rsAttachments.Fields("FileData").SaveToFile outputFileName

Currently when the script runs it exports the first line's attachment as GenHQ.bmp (which is the name of the attachment file). I want it to rename the output attachment file as Gen Albert S. Johnston.bmp ([Unitcard] & .bmp)

ID	STATE	Size	Utype	GenSide	NationFolder	Unit Name	UnitCard	Image	GenImage
1	Bulgarian	Department	Leader	Rebel Genearl	Bulgarian	Department Nr. 2	Gen Albert S. Johnston	BitmapImage	@(1)

 

[theDBguy]

Have you checked out the Name As statement?

Name statement (VBA)

Office VBA reference topic

learn.microsoft.com

 

[UnionWarDog]

Walk your code and see what values you actually have, especially when you have errors.
Set an error routine in your code.

Also please use code tags when you post any code. The </> icon.

I updated the "Code" text correctly now. Thanks for pointing that out. I am able to successfully export the attachments for each line but want to rename the files with the name of the field [Unitcard] & .bmp. That' where I'm stuck. Export works great but many of the attachments are the same file names and I need to create a file for each line of the [Unitcard] column. Hope that explains it better. Best regards.

 

[UnionWarDog]

When I try somethign like this it doesn't work.

Do Until rsAttachments.EOF
         
            Dim outputFileName As String
         
            outputFileName = rsAttachments.Fields("FileName").Value   (Changed it to....  .Fields("UnitCard").Value  but that didn't work)


            outputFileName = ToDirectory & "\" & outputFileName
         
            rsAttachments.Fields("FileData").SaveToFile outputFileName

 

[arnelgp]

you also try this:

Public Sub ExtractAllAttachments(ByVal TableName As String, ByVal AttachmentColumnName As String, ByVal ToDirectory)

Const cNEW_FILE_FIELD As String = "[UnitCard]"

Dim rsMainRecords As DAO.Recordset2
Dim rsAttachments As DAO.Recordset2
Dim outputFileName As String
Dim NewFile As String

Set rsMainRecords = CurrentDb.OpenRecordset("SELECT " & AttachmentColumnName & ", " & cNEW_FILE_FIELD & _
" FROM " & TableName & _
" WHERE " & AttachmentColumnName & ".FileName IS NOT NULL")

Do Until rsMainRecords.EOF

    Set rsAttachments = rsMainRecords.Fields(AttachmentColumnName).Value
 
    Do Until rsAttachments.EOF
 
     
        outputFileName = rsAttachments.Fields("FileName").Value
        NewFile = Trim$(rsMainRecords.Fields(1) & "")
        If Len(NewFile) <> 0 Then
            NewFile = NewFile & ExtensionOfFile(outputFileName)
        Else
            NewFile = outputFileName
        End If
         
        outputFileName = ToDirectory & "\" & NewFile

       'delerte old image
       If Len(Dir$(outputFileName))<>0 then
             Kill outputFileName
      End If
     
        rsAttachments.Fields("FileData").SaveToFile outputFileName
     
        rsAttachments.MoveNext
    Loop
 
    rsAttachments.Close
    rsMainRecords.MoveNext
Loop

rsMainRecords.Close

Set rsAttachments = Nothing
Set rsMainRecords = Nothing

End Sub

 

[UnionWarDog]

you also try this:

arnelgp, I pasted the code in the module but no luck. the 2 files export were only the name of the attachment, not relabeled as the [Unitcard] fields.
LeadersDBList

D	STATE	Size	Utype	GenSide	NationFolder	Unit Name	UnitCard	Image	GenImage
1	Bulgarian	Department	Leader	Rebel Genearl	Bulgarian	Department Nr. 2	Gen Albert S. Johnston	BitmapImage	@(1)
2	Bulgarian	Army	Leader	Rebel Genearl	Bulgarian	Army of the Mississippi	Gen Pierre G.T. Beauregard	BitmapImage	@(1)

ID Line 1 exported the file as The Department Nr. 2.bmp. The file should be Gen Albert S. Johnston.bmp
Line 2 file exported as Army of the Mississippi.bmp but should have exported the file as "Gen Pierre G. T. Beauregard.bmp.

Hope that explains it in better detail. I'm not having issue exporting the attachment or their file names. I'm having issue re-naming the export file with the [Unitcard] text as the name of the .bmp file.

Best regards, UnionWarDog

 

[UnionWarDog]

you also try this:

Public Sub ExtractAllAttachments(ByVal TableName As String, ByVal AttachmentColumnName As String, ByVal ToDirectory)

Const cNEW_FILE_FIELD As String = "[UnitCard]"

Dim rsMainRecords As DAO.Recordset2
Dim rsAttachments As DAO.Recordset2
Dim outputFileName As String
Dim NewFile As String

Set rsMainRecords = CurrentDb.OpenRecordset("SELECT " & AttachmentColumnName & ", " & cNEW_FILE_FIELD & _
" FROM " & TableName & _
" WHERE " & AttachmentColumnName & ".FileName IS NOT NULL")

Do Until rsMainRecords.EOF

    Set rsAttachments = rsMainRecords.Fields(AttachmentColumnName).Value
 
    Do Until rsAttachments.EOF
 
    
        outputFileName = rsAttachments.Fields("FileName").Value
        NewFile = Trim$(rsMainRecords.Fields(1) & "")
        If Len(NewFile) <> 0 Then
            NewFile = NewFile & ExtensionOfFile(outputFileName)
        Else
            NewFile = outputFileName
        End If
        
        outputFileName = ToDirectory & "\" & NewFile

       'delerte old image
       If Len(Dir$(outputFileName))<>0 then
             Kill outputFileName
      End If
    
        rsAttachments.Fields("FileData").SaveToFile outputFileName
    
        rsAttachments.MoveNext
    Loop
 
    rsAttachments.Close
    rsMainRecords.MoveNext
Loop

rsMainRecords.Close

Set rsAttachments = Nothing
Set rsMainRecords = Nothing

End Sub

Works perfect now! I just need to change the field "Unit Name" to"Unitcard". That was my mistake! THANK YOU, arnelgp.

Greatly Appreciated!!

 

[GaP42]

You will still need to ensure that the text string you use as a filename from UnitCard only ever contains valid characters for a filename, or substitute characters that can cause problems. Just sayin. Happy that you were able to resolve your core issue.