Trim File names in a folder using macro

[Halley yenn]

Hi Team,

I have a folder with 70k pdf files with names as below:
AMP_12347890_12347890_Eligible_0908.pdf
ERP_13459000_13459000_Professional_8886.pdf(In these examples EMPID:13459000 and 12347890 are mentioned twice)
I need a macro to rename the above files by deleting one empid as below:
AMP_12347890_Eligible_0908.pdf
ERP_13459000_Professional_8886.
Thanks

 

[Marc L]

Hi, a demonstration as a VBA beginner starter :​

Sub Demo1()
    Const D = "_", P = "D:\Tests4Noobs\"
      Dim F$, S$(), N&
          F = Dir(P & "*.pdf")
    While F > ""
          S = Split(F, D)
          If UBound(S) = 4 Then Name P & F As P & Replace(F, S(2) & D, ""): N = N + 1
          F = Dir
    Wend
        F = N & " files renamed"
        Application.Speech.Speak F, True
        MsgBox F, , "Done !"
End Sub

 

[Halley yenn]

Hi, a demonstration as a VBA beginner starter :​

Sub Demo1()
    Const D = "_", P = "D:\Tests4Noobs\"
      Dim F$, S$(), N&
          F = Dir(P & "*.pdf")
    While F > ""
          S = Split(F, D)
          If UBound(S) = 4 Then Name P & F As P & Replace(F, S(2) & D, ""): N = N + 1
          F = Dir
    Wend
        F = N & " files renamed"
        Application.Speech.Speak F, True
        MsgBox F, , "Done !"
End Sub

Hey Marc,
It is running but not renaming anything!

 

[Marc L]

​

As it rocks on my side so have you forgotten to update the folder Path within the VBA procedure ?​

​

Or maybe your files have specific attributes ?​

Or maybe your files not match your initial post ?​

 

[Halley yenn]

​

As it rocks on my side so have you forgotten to update the folder Path within the VBA procedure ?​

​

Or maybe your files have specific attributes ?​

Or maybe your files not match your initial post ?​

can you try these:
AMR_2789034567_2789034567_DEL-Active_FY20performance_20200204.pdf
AMR_0000300976_0000300976_DEL-Active_FY20performance_20200204.pdf

Required result:
AMR_2789034567_DEL-Active_FY20performance_20200204.pdf
AMR_0000300976_DEL-Active_FY20performance_20200204.pdf

 

[Marc L]

It's what happens when the explanation does not match the real context … ​

​

So you must amend the procedure like this :

If UBound(S) = 5

 

[Halley yenn]

It's what happens when the explanation does not match the real context … ​

​

So you must amend the procedure like this :

If UBound(S) = 5

That is exactly what I did but the result is:
AMR_DEL-Active_FY20performance_20200204.pdf
AMR_DEL-Active_FY20performance_20200204.pdf
not
AMR_2789034567_DEL-Active_FY20performance_20200204.pdf
AMR_0000300976_DEL-Active_FY20performance_20200204.pdf

 

[Marc L]

​

Oh yes this is my bad this time so wait a little …​

 

[Marc L]

My revised demonstration :​

Sub Demo1r()
    Const D = "_", P = "D:\Tests4Noobs\"
      Dim F$, S$(), N&
          F = Dir(P & "*.pdf")
    While F > ""
          S = Split(F, D)
        If UBound(S) = 5 Then
            S(2) = Empty
            Name P & F As P & Replace(Join(S, D), D & D, D)
            N = N + 1
        End If
          F = Dir
    Wend
        F = N & " files renamed"
        Application.Speech.Speak F, True
        MsgBox F, , "Done !"
End Sub

 

[Halley yenn]

My revised demonstration :​

Sub Demo1r()
    Const D = "_", P = "D:\Tests4Noobs\"
      Dim F$, S$(), N&
          F = Dir(P & "*.pdf")
    While F > ""
          S = Split(F, D)
        If UBound(S) = 5 Then
            S(2) = Empty
            Name P & F As P & Replace(Join(S, D), D & D, D)
            N = N + 1
        End If
          F = Dir
    Wend
        F = N & " files renamed"
        Application.Speech.Speak F, True
        MsgBox F, , "Done !"
End Sub

worked like a charm.?
Thanks Marc