I need help in trapping a bug in image uploading code - vba

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
2,169
Office Version
  1. 2016
Platform
  1. Windows
I was able to come up with this code after adding pieces together. The only thing is that I don't really understand what most of the lines are doing but it's working for me so I am cool with it.
Code:
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

Then I later had issues beyond what I can handle!

When I turn the alert off, I get an error on this line when I want to change the image in the control.
Code:
Name FileNameOnly & Ext As NewFileName & Ext

The funny part is that this happens when I want to change the image immediately after uploading one. But when I close the form and trying changing the image, it works.

I am sure I am missing something but can't seem to figure it out yet.

I should be able to update the image anytime I want - but it looks as if that's not working for me now.


Can someone pull it up for me?
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
No variable defined for
NewFileName = freg2.Text

My first impression is that the file is being locked by some application or the download hasn't completed. Do you have it open with a picture viewer while trying to change the name of it?
 
Upvote 0
Oh I think I have identified what's causing me the headache! !!

Since my initial idea was to move the file instead of copying as I am having it currently, I never anticipated the possibility of the named image already existing in the location .

So now, I want a way to restore back the original file name after I am done with the copy.

So I need a variable to store the original file name. Then after I am done with the copying - that's if the source path is not the same as the destination path, then I restore back the original file name to the file at the source path.
 
Upvote 0
I think I just solved the puzzle! !!!

Code:
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
                 


                sFile = Dir(NewFileName & ".*")
            While Len(sFile) > 0
                Ext = Right(sFile, Len(sFile) + 1 - InStrRev(sFile, "."))
                Name NewFileName & Ext As FileNameOnly & Ext
                sFile = Dir
            Wend

            End If
        End If
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top