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

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,826
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?
 

Some videos you may like

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
1,824
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?
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,826
Office Version
  1. 2016
Platform
  1. Windows
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.
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,826
Office Version
  1. 2016
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,118,756
Messages
5,574,049
Members
412,565
Latest member
roberttaekim
Top