my $path = '\nbs\main\den\rel_10.\cr_Q00472526-03-1\final';
   $path =~ s/[^\\]+\\(\w+)$/$1/ ;
   print $path;

__END__
\nbs\main\den\rel_10.\final
[download]

Update:
My conscience nags me that this answer is not reliable. Suppose you have something at the end that doesn't match \w+, as is (all too) typical of modern file paths?

So, here's another version that's more cautious

   my ($leaf ) = $path =~ m/[^\\]+$/g ;  #save the leaf
   $path =~ s/(.+)\\.+\\$leaf$/$1/;      #prune the branch
   $path .= "\\$leaf";                   #graft the leaf
   print "$path\n";

__END__
\nbs\main\den\rel_10.\final
[download]

Hey mkmcconn , it works fine but when the path get longer it doesn't ,, I am trying to caputure the last one before \final no matter how big is the path and delete it ,, I am trying to modify it here hopefully , I will get it .. thanks

    my @chunks = split /\\/ => $data;
    splice @chunks => -2, 1 if $chunks [-1] eq 'final';
    $data = join "\\" => @chunks;
[download]

Abigail

#!/usr/bin/perl -w
use File::Basename;
fileparse_set_fstype("MSDOS");
my $path = '\nbs\main\den\rel_10.\cr_Q00472526-03-1\final';
$path = dirname(dirname($path))."\\".basename($path);
print $path,"\n";
[download]