format the cells in column

[KlausW]

Hi
I use this VBA code to rename images and it works well.
I have done something so that the text in column D, new image name cannot be recognised. And I for the following error message.
I can't figure out how to format the cells in column D so that the VBA code can use them.
Anyone who can help?
Any help will be appreciated.
Best regards
Klaus W

File for help

Sub Rektangelafrundedehjørner1773_Klik()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Ark1")

Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
 
Dim new_name As String
 
Set fo = fso.GetFolder(sh.Range("e1").Value)
 
For Each f In fo.Files
      new_name = Application.VLookup(f.Name, sh.Range("A:d"), 4, 0)
      f.Name = new_name
Next
 
MsgBox "Done"


End Sub

 

[rollis13]

In column A you are entering file names without the extension, therefore, in the above macro instead of:

new_name = Application.VLookup(f.Name, sh.Range("A:D"), 4, 0)

you need to use:

new_name = Application.VLookup(Left(f.Name, InStr(f.Name, ".") - 1), sh.Range("A:D"), 4, 0)

By the way, you then will find other issues that need to be solved.

 

[KlausW]

Thank but that did not solout the problem.

 

[rollis13]

Sorry but I knew, that's what I said in post #2; I resolved your issue Run-time Error 13 and since I have no idea on what your project is supposed to do I'm not even going to do the dirty job on trying to fix unknown issues.

 

[KlausW]

Sorry but I knew, that's what I said in post #2; I resolved your issue Run-time Error 13 and since I have no idea on what your project is supposed to do I'm not even going to do the dirty job on trying to fix unknown issues.

Thanks, I use the file to rename images with. On the green button I get picture names and pictures. They come in columns A and B. They are retrieved from the folder in cell E1. I write the new name in column C. And in column D Excel then put *.jpg on it. And when I press the blue button / run the VBA code, the images should be renamed in the folder. This was running a few days ago. But now I have ruined it. KW

 

[rollis13]

Looking at your macros I doubt the name change ever worked.

So, in your macro "Rektangelafrundedehjørner2_Klik" (green) this line unnecessarily reorders column A but at the same time doesn't reorder the images so don't use it (or fix it):

Range(.Cells(2, 1), .Cells(i, 1)).Sort Key1:=.Cells(2, 1), Order1:=xlDescending

Now, by following your explanation in post #5 in macro "Rektangelafrundedehjørner1773_Klik" (blue), as explained in my post #2, these lines need to be changed:

new_name = Application.VLookup(f.Name, sh.Range("A:D"), 4, 0)
f.Name = new_name

to this:

new_name = Application.VLookup(Left(f.Name, InStr(f.Name, ".") - 1), sh.Range("A:D"), 3, 0) '<- changed
f.Name = new_name & Application.VLookup(Left(f.Name, InStr(f.Name, ".") - 1), sh.Range("A:D"), 4, 0) '<- changed

N.B.: Note that in column D you only need to write .jpg (without the asterisk).
If it always has to be .jpg then the entire column D is unnecessary. All you have to do is use the above lines like this:

new_name = Application.VLookup(Left(f.Name, InStr(f.Name, ".") - 1), sh.Range("A:D"), 3, 0)
f.Name = new_name & ".jpg" '<- changed

 

[KlausW]

Hi rollis13

Thanks for that VBA code
I don't understand anything when I put your VBA code corrections in the right places. And run code it works. If I run the code one more time it comes up with the same error code. Run-time error 13 Type mismatch.
Could the formatting of the cells have any influence, could it be the images? Would it help to move the images to another column?
Best regards
Klaus W

 

[rollis13]

If I run the code one more time

This isn't a good idea, once a file has been renamed at the next run the old name will no longer be found giving Runtime Error 13.

Could the formatting of the cells have any influence

No, formatting isn't considered in the macro so can't influence.

Would it help to move the images

No, would have no effect on names and reference to ranges in the macro would only need to be updated.

 

[KlausW]

Good morning rollis13, thanks for the information. I have inserted the codes you sent me. Can you not rename a file if it has already been renamed, by VBA code? The new name appears in column A. If you like, I have created the file from which I built the VBA code. Good day and greetings from Denmark Klaus W
Link to files

 

[rollis13]

Sorry, the link provided doesn't work.
So I'll assume what your macro might be at the moment. I added the code to skip all errors (missing, duplicates, misspelled names, etc.):

Sub Rektangelafrundedehjørner1773_Klik()
    'blue button
    Dim sh     As Worksheet
    Set sh = ThisWorkbook.Sheets("Ark1")
    Dim fso    As New FileSystemObject
    Dim fo     As Folder
    Dim f      As File
    Dim new_name As String
    Set fo = fso.GetFolder(sh.Range("E1").Value)
    On Error Resume Next                          '<- added
    For Each f In fo.Files
        new_name = Application.VLookup(Left(f.Name, InStr(f.Name, ".") - 1), sh.Range("A:D"), 3, 0)
        If Not new_name = "" Then f.Name = new_name & ".jpg" '<- changed
    Next
    MsgBox "Done"
End Sub