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]