PDA

View Full Version : Replace between last backslash and period.



jolivanes
10-29-2006, 09:02 PM
I want to replace the filename part without affecting the path and extension.
The path can be nested several folders, 1, 2, 3 or more, deep and the file extensions are usually 2 and 3 characters.
Cell A2: C:\Folder One\Folder Two\Folder Three\Filename.TXT
Cell A3: C:\Folder One\Folder Two\Folder Three\Another Filename.NO
etc
Cell B2: New Filename
Cell B3: New Another Filename
etc
In Cell C2, I would like to end up with C:\Folder One\Folder Two\Folder Three\New Filename.TXT
In Cell C3, I would like to end up with C:\Folder One\Folder Two\Folder Three\New Another Filename.NO
etc
Is this possible without Text to columns twice, once for the backslash and once for the period and if so, how would I do that?
Thanks and regards
John

Jacob Hilderbrand
10-29-2006, 10:08 PM
This should do the trick:

=LEFT(A2,FIND("@@@",SUBSTITUTE(A2,"\","@@@",LEN(A2)-LEN(SUBSTITUTE(A2,"\",""))),1)-1)

=D2&"\"&B2

jolivanes
10-30-2006, 12:07 AM
Jake.
Thanks for your solution. Works like a charm. I neglected to mention that my idea was to do it with a macro because I stripped the extension with a macro anyway. I came up with the following:


Option Explicit
Sub ChangeFileName()
Application.ScreenUpdating = False
'Range("C2", Range("C2").End(xlDown)).ClearContents
Range("E2").Select
Do While ActiveCell.Offset(0, -4).Value > ""
ActiveCell = ActiveCell.Offset(0, -4).Value
Selection.Replace What:="*.", Replacement:="" 'ActiveCell.Offset(0, -1).Value
ActiveCell.Offset(1, 0).Select
Loop
Range("C2").Select
Do While ActiveCell.Offset(0, -2).Value > ""
ActiveCell.FormulaR1C1 = <A href="mailto:"=LEFT(RC[-2],FIND(""@@@"",SUBSTITUTE(RC[-2],""\">"=LEFT(RC[-2],FIND(""@@@"",SUBSTITUTE(RC[-2],""\"",""@@@""," & _
"LEN(RC[-2])-LEN(SUBSTITUTE(RC[-2],""\"",""""))),1)-1)&""\""&RC[-1]&"".""&RC[2" > "=LEFT(RC[-2]," & _
<A href="mailto:"FIND(""@@@"",SUBSTITUTE(RC[-2],""\"",""@@@"",LEN(RC[-2])-LEN(SUBSTITUTE(RC[-2],""\"",""""))),1)-1">"FIND(""@@@"",SUBSTITUTE(RC[-2],""\"",""@@@"",LEN(RC[-2])-LEN(SUBSTITUTE(RC[-2],""\"",""""))),1)-1)" & _
"&""\""&RC[-1]&"".""&RC[2]"
ActiveCell.Offset(1, 0).Select
Loop
Range("C2", Range("C2").End(xlDown)).Copy
Range("C2").PasteSpecial Paste:=xlPasteValues 'Select
'Selection.PasteSpecial Paste:=xlPasteValues
Range("E2", Range("E2").End(xlDown)).ClearContents
Application.ScreenUpdating = True
End Sub


Not very efficient I am sure for guys like you but it works!!!

If you have any pointers, I'd love to hear about them.

Thanks and regards.

John

jolivanes
10-30-2006, 12:10 AM
After posting I noticed that I should have cut the formula in sections. Sorry about that.

Jacob Hilderbrand
10-30-2006, 12:52 AM
If you want a macro you can use something like this:


Option Explicit

Sub ChangeFileName()

Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long
Dim LastRow As Long
Dim Path As String
Dim FullName As String
Dim NewName As String

Application.ScreenUpdating = False

LastRow = Range("A65536").End(xlUp).Row
Range("C2:C65536").ClearContents
For i = 2 To LastRow
FullName = Range("A" & i).Value
NewName = Range("B" & i).Value
If InStr(1, FullName, "\", vbTextCompare) = 0 Then
GoTo NextLoop:
End If
For j = Len(FullName) To 1 Step -1
If Mid(FullName, j, 1) = "\" Then
Exit For
End If
Next j
Path = Left(FullName, j)
Range("C" & i).Value = Path & NewName

NextLoop:

Next i


ExitSub:

Application.ScreenUpdating = True

End Sub

jindon
10-30-2006, 12:52 AM
Hi
try

Sub test()
Dim r As Range, txt As String
With CreateObject("vbscript.regexp")
For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
.Pattern = "[^\\]+$"
If .test(r.Value) Then
txt = .Replace(r.Value, r.Offset(, 1).Value)
.Pattern = "\..+$"
If .test(r.Value) Then
txt = txt & .Execute(r.Value)(0)
End If
r.Value = txt
End If
txt = ""
Next
End With
End Sub


edited : 17:01 Tokyo time

SamT
10-30-2006, 07:28 AM
DRJ,

As you know, I'm just a noob. I try to understand the solutions offered here on the theory that "you can't write til you can read"

I'm really miising something here. I misread your code as

Loop thru the rows
If FullName NOT have a "\" ie, not a path then
skip to the next Row
Else
Check if Fullname DOES have "\" Then
Stop Checking
Else
Continue Checking
End Check
Write New Path\Name to "C"

What am I NOT Seeing?

SamT

SamT
10-30-2006, 08:18 AM
jolivanes,


For i = Len(FullName) To 1 Step -1
If InStr(i, OldName, "\") <> 0 Then
SlashIndex = i
GoTo Endslash
Else
Next i
EndSlash:

For i = Len(FullName) To 1 Step -1
If InStr(i, OldName, ".") <> 0 Then
DotIndexIndex = i
GoTo EndDot
Else
Next i
EndDot:

NewName = Left(FullName, slashIndex) v& NewName & Right(Fullname, DotIndex)

jolivanes
10-30-2006, 10:31 AM
Jake, Jindon and SamT.
Thanks for your responses.

Jake.
How would I incorporate the extension with your macro. I works perfect but once when I have the new name, I need to rename the files in the respective folder. They need an extension of course.

Jindon.
Works like a charm also, but as I mentioned above, I need te retain the original filename so I can change the filenames in the folder they're in. I'll try to change it to Column C. I guess I could copy the cells from Column A to Column C.

SamT
I must have inserted your macro at the wrong place. It bombs at several points. I have not thouroughly gone through it yet to see if I am able to fix it but I will try later on.

Thanks for your help.

John

SamT
10-30-2006, 11:05 AM
Jolevanes,

Oops! Sorry, thats's just PseudoCode and I forgot to mark it so.

I think I'm pretty good at logic, but it still takes me far too long to translate PseudoCode to VBA Code.
That little bit only took me about 15 minutes, or about the same time it takes me to translate ONE line into VBA.

For instance, I didn't declare ANY variables above.

Now I gotta run off again.

SamT

mdmackillop
10-30-2006, 12:06 PM
Try

Option Explicit
Sub ChangeFileName()
Dim OldName As String
Dim Ext As String
Dim MyStr As String
Dim LastRow As Long, i As Long
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastRow
MyStr = Range("A" & i)
OldName = Split(MyStr, "\")(UBound(Split(MyStr, "\")))
Ext = "." & Split(MyStr, ".")(UBound(Split(MyStr, ".")))
Range("C" & i) = Left(MyStr, Len(MyStr) - Len(OldName)) & Range("B" & i) & Ext
Next i
Application.ScreenUpdating = True
End Sub

Jacob Hilderbrand
10-30-2006, 01:54 PM
Jake.

How would I incorporate the extension with your macro. I works perfect but once when I have the new name, I need to rename the files in the respective folder. They need an extension of course.



I am not sure what the problem is. Is the extension in the new name or do you need to take the extension from the original name and just replace the file name part with the new name (keeping the original path and extension)?

jolivanes
10-30-2006, 03:22 PM
mdmackillop.
Works perfect.
Thank you very much for your help.
John

jolivanes
10-30-2006, 03:31 PM
Hi Jake.
Sorry for the confusion but the extension is not in the so called new name. The extension needs to be copied from the old name. Essentially what I wanted is replace the filename only without touching the path and extension. The result should be in a separate column so I can rename the files in the folders where they're in. Maybe my explanation at the first thread was not clear on this.
Thanks and regards.
John

jindon
10-30-2006, 05:37 PM
Just change


r.Value = txt
To

r.offset(,2).Value = txt
in my code then

jolivanes
10-30-2006, 05:55 PM
Hi Jindon.
I had copied the cells in Column A to Column C and let your macro work on Column C but this is a lot easier.
Thanks Jindon
Regards
John