Need help with rename and copy image files instead of deleting and moving them - vba

[kelly mort]

I have this code here that I use to upload images to my application.

It's doing the job just that there are a few lines I want to modify.

Here, I want the app to alert me if the name I have accepted from the freg2 is already assigned to an image file in the destination folder.
But it flags the alert anytime I am uploading the image from the destination folder.

Here too, instead of deleting the image if it's already found in the folder, I want to rename it.
Maybe image1 for the old file before bringing the new file.

So if the image is named "red apple" in the folder and I am uploading a new "red apple" from a different folder, then I rename the old image as "red apple1".

And instead of moving the file from the source, I want to copy it instead.

I wrote this code long ago after adding some pieces together. But now, I am stucked as to how to get what I want working for me.

I need Tech support.

Thanks

 

[xenou]

I doesn't sound too hard although renaming files is tricky (what if you try to rename a file to a name that is also a file that already exists .... !!). I would suggest you post your code not as images so it can be copied and tested on this end without having to retype it all. Also for what its worth you should just start trying out some code as you will probably be able to figure out most of this I guess.

 

[kelly mort]

Sub UploadImage()
   Dim NewFileName, FileExists$, FileName$, FileNameOnly$
    Dim fso As Object, FileToCopy$, FileAtDest$, Ext$
    Dim srcPath$, dstPath$, myFile, Fileselected, sFile$
    
    NewFileName = freg2.Text
    Set myFile = Application.FileDialog(msoFileDialogOpen)
    Set fso = CreateObject("Scripting.FileSystemObject")
    With myFile
        .Title = "Please select the image file"
        .AllowMultiSelect = False
        .Filters.Add "Images", "*.jpg; *.jpeg", 1
        If .Show <> -1 Then
            MsgBox "No image file was selected. Try again", , "Canceled Alert"
            Exit Sub
        End If
        FileName = .SelectedItems(1)
        srcPath = .InitialFileName
        dstPath = ThisWorkbook.Path & "\PASSPORT PICTURES\"
        FileNameOnly = Left(FileName, InStr(FileName, ".") - 1)
        FileToCopy = Dir(srcPath & NewFileName & ".*")
        If Len(FileToCopy) Then
            MsgBox "The selected image already exists. Try again", , "File Exists Alert"
            Exit Sub
        Else
            sFile = Dir(FileNameOnly & ".*")
            While Len(sFile) > 0
                Ext = Right(sFile, Len(sFile) + 1 - InStrRev(sFile, "."))
                Name FileNameOnly & Ext As NewFileName & Ext
                sFile = Dir
            Wend
        End If
        If srcPath <> dstPath Then
            FileAtDest = Dir(dstPath & NewFileName & ".*")
            FileExists = Dir(srcPath & NewFileName & ".*")
            If Len(FileExists) Then
                If Len(FileAtDest) Then Kill dstPath & NewFileName & ".*"
                fso.movefile Source:=srcPath & NewFileName & ".*", Destination:=dstPath
                'fso.COPYfile Source:=srcPath & NewFileName & ".*", Destination:=dstPath
            End If
        End If
    End With
End Sub

 

[kelly mort]

@xenou,
I don't want to rename the file anymore.
I think the deleting is okay for now.

So I only want to fix the moving of the file to copying.

And also the alert to check if the name I am accepting from the textbox is already assigned to an image file in the destination folder.

Thanks

 

[xenou]

Hi, it looks like you have your alert already:

       If Len(FileToCopy) Then
            MsgBox "The selected image already exists. Try again", , "File Exists Alert"
            Exit Sub
        Else
        '// ....

For copying instead of moving you probably just want to replace your MoveFile command with CopyFile instead, at the end:

               'fso.movefile Source:=srcPath & NewFileName & ".*", Destination:=dstPath
                fso.COPYfile Source:=srcPath & NewFileName & ".*", Destination:=dstPath

 

[kelly mort]

Thanks for the script. The copy is working now.
But the alert part is not doing the job.

Could it be a memory issue?
When I add an image and a run the code again for the second time, trying to change the image, it tells me the image is already available.
But I want a what that I could be able to change the image anytime I want.

I tried turning off the alert and I had the error here:

Name FileNameOnly & Ext As NewFileName & Ext

Can someone fix this for me?

I have tried all my tricks but non is working for me.