Get last name of workbook

[annupojupradeep]

Hi Friends,

Good Morning....

I am trying write code to find the last name of workbook and copy workbook. Paste those workbook in the respective files.

Examaple:

I have files like 401020_2350.xls, 400100_4060.xls, 134010_0585.xls and 348100_1153.xls.

My requieremnt is if last name of workbook contains 2350 and 4060 then these workbooks get copy and paste in Folder Brazil. If workbook file contains 0585 and 1153 then these workbooks get copy and paste in folder Europe.


I have searched in different sites....but i could get not any result.


Thanks & regards,
Pradeep

[jewelsharma]

modify as needed. Good Luck

Please Login or Register  to view this content.

If you think this has satisfactorily answered your need. Please mark the thread as Solved.

Warm regards,
Jewel

[annupojupradeep]

Hi Jewel,

Thanks so much....

I have modified the codes as per my requirement but its not working.

Please Login or Register  to view this content.

Its surprise that macro runs and ends successfully but not copying files and paste in respective folders.

Could you please suggest, if I have done any wrong in modifying the macro.

Fortunately I am not getting any debug also.

Thanks & regards,
Pradeep

[jewelsharma]

Here you go. I've made slight changes to the code:

Please Login or Register  to view this content.

The above code is working fine on my PC now.
Notes:

• Do make sure that "Brazil" & "Europe" folders don't have any files by the same file name(s) in them already.
• I ran this Macro through a separate workbook (i.e. not the one that was to be sorted). Though I'm really sure if this is of any significance.

Let me know if this worked for you, or if you had any issues.

Warm regards,
Jewel

[annupojupradeep]

Hi Jewel,

Wowww..... thank you so much its working now perfectly.....

As its opens files and save as in the respective folder.

Based on your codes I am trying to edit with this code please suggest whether my code is correct or not because while run the macro
its showing Run-Time Error "53" File not Found.

====================================================
Sub Sort_Files()
Dim oFSO As Object, oFiles As Object, oFile As Object
Dim sOriginalFolder As String, sBrazilFolder As String, sEuropeFolder As String, sFileName As String


Application.ScreenUpdating = False
Application.DisplayAlerts = False

sOriginalFolder = "C:\Example\" '(Change to current directory. Must end with "\")
sBrazilFolder = "C:\Example\Brazil\" '(Change to desired directory. Must end with "\")
sEuropeFolder = "C:\Example\Europe\" '(Change to desired directory. Must end with "\")
'FExtension = "*.xls"

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFiles = oFSO.GetFolder(sOriginalFolder).Files

For Each oFile In oFiles

sFileName = Split(oFile.Path, "\")(UBound(Split(oFile.Path, "\")))

If Right(sFileName, 9) = "_2350.xls" Or Right(sFileName, 9) = "_4060.xls" Then

oFSO.MoveFile Source:=sOriginalFolder, Destination:=sBrazilFolder
Else

' Application.Workbooks.Open Filename:=oFile.Path
' With Workbooks(sFileName)
' .SaveAs Filename:=sBrazilFolder & sFileName
' .Close
' End With


'End If


If Right(sFileName, 9) = "_0585.xls" Or Right(sFileName, 9) = "_1153.xls" Then

oFSO.MoveFile Source:=sOriginalFolder, Destination:=sEuropeFolder


'Application.Workbooks.Open Filename:=oFile.Path
'With Workbooks(sFileName)
' .SaveAs Filename:=sEuropeFolder & sFileName
' .Close
' End With
End If
End If
Next oFile

Set oFSO = Nothing
Set oFiles = Nothing
Set oFile = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

=============================================================




Thanks & regards,
Pradeep

[jewelsharma]

The object that is being evaluated/manipulated is "oFile" not "oFSO". Change this:

Please Login or Register  to view this content.

with

Please Login or Register  to view this content.

do the same for the sEuropeFolder line in the Else statement. As your original issue is solved. I request you to kindly mark the thread as SOLVED.
For any follow-up queries, please start a new thread.

[annupojupradeep]

Hi Jewel,

Now its working perfectly....thanks so much for your help


Thank & regards,
Pradeep