Batch Copy and Rename (1 Viewer)

[monfas]

Hi,

I'm having sporadic problems with a code to copy and rename photos.

This code is supposed to loop around a directory of photos (named after a project), and then copy a new photos (from another directory) to this folder, numbering them and the logging them in a table tphotos.

The first time a copy photos to a new directory the code works fine. And I think I had it working fine before, but now when I copy photos to a pre-existing directory that has already photos, it only overwrites the first photo, instead looking for the last photo and attributing the new photo number n+1.

I've done debug.print in the code, and it looks like is not going into If NewFileName = f1.Name, therefore doesn't compare the newfilename with the files in the folder.

Does anyone can help me understanding why this only works when I copy the photos the first time.:banghead:

Private Sub cmdAddPhoto_Click()
Dim fs, f, f1, fc, s
Dim fDial As FileDialog
Dim SourcefileName, destDir, FileExt, NewFileName, prjID As String
Dim intSel, FileNumber As Integer
Dim varSelFile As Variant
Dim rsPhoto As Recordset
Dim myDB As Database

Set fDial = Application.FileDialog(msoFileDialogFilePicker)
Set fs = CreateObject("Scripting.FileSystemObject")                             'here comands access to open an object which is the destination directory
Set f = fs.GetFolder(Me.tpath.Value)
Set fc = f.Files
Set myDB = CurrentDb

prjID = Me.cPrj.Value
destDir = Me.tpath.Value
FileNumber = 0

With fDial
    .Title = "Choose Files to copy to " & destDir
    .Filters.Add "All image files", "*.bitmap; *.BMP; *.CDR; *.CPT; *.CR2; *.Exif; *.GIF; *.ICO; *.icon; *.j2k; *.jp2; *.jpc; *.JPEG; *.jpg; *.jpx; *.pcc; *.pcx; *.pmm; *.psd; *.psp; *.RAW; *.tif; *.TIFF; *.wmf; *.xbm; *.XCF; *.xpm", 1
    .AllowMultiSelect = True
    .InitialFileName = "C:\"

        If .Show = -1 Then
            For Each varSelFile In .SelectedItems                               'for each of the selected items
            SourcefileName = Dir(varSelFile, vbDirectory)                       'find the name of the file
            FileExt = (Mid(SourcefileName, (InStr(1, SourcefileName, "."))))    'find the file extension to add to the later copy
1           NewFileName = prjID & Format(FileNumber, "000") & FileExt           'atributes a new temporary file name - newfilename
                                   
                For Each f1 In fc
                
                If NewFileName = f1.Name Then                           ' loop and compares the newfilename with the files in the destination directory, to ensure is not overwriting.
                FileNumber = FileNumber + 1                             ' if finds a match, adds one value to the photo number filenumber = filenumber + 1
                GoTo 1
                End If                                                  'if doesn't find a match, loops until last file and copies the file with the new name that is referenced to the project
              
                Next
                
              FileCopy varSelFile, destDir & NewFileName
              
              Set rsPhoto = myDB.OpenRecordset("SELECT [tPhotos].* From [tPhotos] WHERE photoID = null ", DB_OPEN_DYNASET)
              With rsPhoto
                   .AddNew
                   rsPhoto!prjID.Value = Me.tPrjID.Value
                   rsPhoto!photoPath.Value = destDir & NewFileName
                   rsPhoto!photoAuthor.Value = Me.tAuthor.Value
                   rsPhoto!PhotoComment.Value = Me.tcomment.Value
                   rsPhoto!photoPlaceTaken.Value = Me.tPlace.Value
                   rsPhoto!photoName.Value = NewFileName
                   rsPhoto!PhotoLog.Value = Forms!flog_in.uName
                   .Update
                   .Close
              End With
                                                             
            Next varSelFile
        Else
        End If

End With
Set fDial = Nothing

With Me.sfPhotoDetail.Form
    .Filter = "prjID = " & Me.tPrjID.Value
    .FilterOn = True
End With
Me.sfPhotoDetail.Requery

Exit Sub
error_HGen:
    MsgBox "Error:(" & Err.Number & ") " & Err.Description, vbCritical


End Sub

 

[Mihail]

I think that the code "not going into If NewFileName = f1.Name" because the equality fail for each f1. So, you must insert a Debug.Print BEFORE the If statement.

Debug.Print Len(NewFileName) & "   " & NewFileName
Debug.Print  Len(f1.Name) & "   " & f1.Name
Debug.Print 'Insert a empty line

  If NewFileName = f1.Name
............

You must check the string length to know that the string not include non printable characters.

Hope this is a help for you

 

[monfas]

Hi Mihail, thanks,

I just put the debug print as you suggested (see code bellow). This morning the code was working fine (without me making any changes), however can't still can't make much sense of the fact that never is writen the A1 suffix

 NewFileName = prjID & Format(FileNumber, "000") & FileExt           'atributes a new temporary file name - newfilename
            Debug.Print Len(NewFileName) & "   " & NewFileName & "A1"
            Debug.Print 'Insert a empty line
            
                For Each f1 In fc
                
                Debug.Print Len(NewFileName) & "   " & NewFileName & "B1"
                Debug.Print Len(f1.Name) & "   " & f1.Name & "B2"
                Debug.Print 'Insert a empty line
                
                If NewFileName = f1.Name Then                           ' loop and compares the newfilename with the files in the destination directory, to ensure is not overwriting.
                FileNumber = FileNumber + 1                             ' if finds a match, adds one value to the photo number filenumber = filenumber + 1
                Debug.Print Len(NewFileName) & "   " & NewFileName & "C1"
                Debug.Print Len(f1.Name) & "   " & f1.Name & "C2"
                Debug.Print 'Insert a empty line
                
                GoTo 1
                End If                                                  'if doesn't find a match, loops until last file and copies the file with the new name that is referenced to the project
                Debug.Print Len(f1.Name) & "   " & f1.Name & "D1"
                Next
                
              Debug.Print Len(NewFileName) & "   " & NewFileName & "D2"
              
              Debug.Print 'Insert a empty line

The debug print results are the following (when I added a photo to the folder and the last photo in the folder was 199038)

10 199000.jpgA1

10 199000.jpgB1
10 199000.jpgB2

10 199000.jpgC1
10 199000.jpgC2

10 199001.jpgA1

10 199001.jpgB1
10 199000.jpgB2

10 199000.jpgD1
10 199001.jpgB1
10 199001.jpgB2

10 199001.jpgC1
10 199001.jpgC2

10 199002.jpgA1

10 199002.jpgB1
10 199000.jpgB2

10 199000.jpgD1
10 199002.jpgB1
10 199001.jpgB2

10 199001.jpgD1
10 199002.jpgB1
10 199002.jpgB2

10 199002.jpgC1
10 199002.jpgC2

10 199003.jpgA1

10 199003.jpgB1
10 199000.jpgB2

10 199000.jpgD1
10 199003.jpgB1
10 199001.jpgB2

10 199001.jpgD1
10 199003.jpgB1
10 199002.jpgB2

10 199002.jpgD1
10 199003.jpgB1
10 199003.jpgB2

10 199003.jpgC1
10 199003.jpgC2

10 199004.jpgA1

10 199004.jpgB1
10 199000.jpgB2

10 199000.jpgD1
10 199004.jpgB1
10 199001.jpgB2

10 199001.jpgD1
10 199004.jpgB1
10 199002.jpgB2

10 199002.jpgD1
10 199004.jpgB1
10 199003.jpgB2

10 199003.jpgD1
10 199004.jpgD2

I can't make much sense of why is this working today. (I didn't change anything in the code besides adding the debug prints.

I will try this code in another machine today and see how it works fine. Nevertheless, do you have any hint of what is going on? Will it be a problem with my computer instead? Because some other times it looked like some "If clauses" where not working properly". Thanks

 

[Mihail]

I have noticed too that sometimes this thing is happen.
When I can't see any error in my code or in my logic but the code refuse to do the job I restart the Access application or even my computer.

I can't explain that. Maybe more experimented guys can. I think that is something about the "corruption" but I can't be sure.

 

[monfas]

Ok, thanks anyway. I will see if anyone else knows what is going on. I'm just afraid this will happen when the application is running.

Cheers,

 

[stopher]

Generally speaking you should not use GOTO in the main code except for handling errors. It makes you code difficult to read/debug and can also lead to a tangled web of code leading to more errors. Better to use constructs such as Do-Loop.

Instead of looping through all the files in the destination folder, I would recommend using the FileExists method of the FSO model. So the code can be condensed to:

            FileNumber = -1
            Do
                FileNumber = FileNumber + 1
                NewFileName = prjID & Format(FileNumber, "000") & FileExt
            Loop Until Not fs.FileExists(destDir & NewFileName)

Instead of your code original code:

FileNumber=0
....
....
1           NewFileName = prjID & Format(FileNumber, "000") & FileExt           'atributes a new temporary file name - newfilename
                                   
                For Each f1 In fc
                
                If NewFileName = f1.Name Then                           ' loop and compares the newfilename with the files in the destination directory, to ensure is not overwriting.
                FileNumber = FileNumber + 1                             ' if finds a match, adds one value to the photo number filenumber = filenumber + 1
                GoTo 1
                End If                                                  'if doesn't find a match, loops until last file and copies the file with the new name that is referenced to the project
              
                Next

You can also then get rid of redundant variables used in your old code.

hth
Chris