Results 1 to 8 of 8

Thread: Help Needed for unique task
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Mar 2011
    Location
    Sheffield
    Posts
    26
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Help Needed for unique task

    Good evening Ladies & Gentlemen

    I have been asked by a friend if I could help with an issue she faces on a weekly basis with excel workbooks

    Basically on the Monday morning of each week, she has to open a folder and view excel workbooks contained within
    that has around 80 - 150 workbooks at any one time, copy all workbooks to another folder

    she then has to rename said workbooks individually to a Name (normally a customer), and then the date of that Monday for example
    she renamed 86 excel workbooks from Briggs 22 July 2019 to Briggs 29 July 2019

    all the workbooks start off with different names for example

    Briggs
    22 July 2019
    Jones
    22 July 2019
    David
    22 July 2019
    Wright
    22 July 2019

    is there a script or macro via excel that can look at the folder (even browse to it from within the script); and then rename the last portion of the file name to the date needed

    I thought that maybe having a reference point on a sheet in cell A1 that reads Briggs

    and a script that asks for the folder location (browse to); then asks for the date and off it goes opening and saving the workbook, based on the name in cell A1 in sheet "NewDate"

    and at the end of the work, pops a message up saying how many workbooks it has renamed, so she can check the folder to ensure none are missed

    The reason i am asking is this is well beyond my skill level, and so i reach out to this forum for advice and or guidance

    Thanks in advance


  2. #2
    New Member
    Join Date
    Jul 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Help Needed for unique task

    You could do most or all of this in a scripting language like python. Search rename file python. Search list file in a folder python.

    example:
    https://www.geeksforgeeks.org/rename...-using-python/

  3. #3
    Board Regular igold's Avatar
    Join Date
    Jul 2014
    Location
    Delray Beach, FL, USA
    Posts
    2,361
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Help Needed for unique task

    How about something like this...

    Code:
    Sub RenameSaveWorkbooks()
    
    
        Dim wb As Workbook
        Dim myPath As String, myFile As String, myExtension As String
        Dim FldrPicker As FileDialog
        Dim OldName As String, NewName As String, NewDate As String, NewPath As String
        Dim n As Integer, ct As Long
        
        Application.ScreenUpdating = False
        Application.EnableEvents = False
    
    
        Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
        With FldrPicker
          .Title = "Select the Folder With Old Workbooks"
          .AllowMultiSelect = False
            If .Show <> -1 Then GoTo NoPick
            myPath = .SelectedItems(1) & "\"
        End With
    
    
    NoPick:
        myPath = myPath
        If myPath = "" Then GoTo CleanUp
        
        myExtension = "*.xls*"
        myFile = Dir(myPath & myExtension)
        NewDate = InputBox("Please Enter the New Date For Saving")
        NewPath = InputBox("Please Enter the New Folder Path For Saving")
        If Not Right(NewPath, 1) = "\" Then NewPath = NewPath & "\"
    
    
        Do While myFile <> ""
            Set wb = Workbooks.Open(Filename:=myPath & myFile)
            DoEvents
            With ActiveWorkbook
                OldName = .Name
                n = InStr(OldName, " ")
                OldName = Left(OldName, n - 1)
                NewName = OldName & " " & NewDate
                .SaveAs Filename:=NewPath & NewName & ".xls"
                ct = ct + 1
            End With
            wb.Close SaveChanges:=True
            DoEvents
            myFile = Dir
        Loop
    
    
        MsgBox "Operation Complete!" & vbNewLine & vbNewLine & _
            ct & " Workbooks were renamed and saved to your new location."
    
    
    CleanUp:
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    
    
    End Sub
    ​igold

    I'm a drinker with a coding problem...

    All code is written with Excel 2010 - Please test all code on a backup copy of your data.


  4. #4
    New Member
    Join Date
    Mar 2011
    Location
    Sheffield
    Posts
    26
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Help Needed for unique task

    Quote Originally Posted by igold View Post
    How about something like this...

    Code:
    Sub RenameSaveWorkbooks()
    
    
        Dim wb As Workbook
        Dim myPath As String, myFile As String, myExtension As String
        Dim FldrPicker As FileDialog
        Dim OldName As String, NewName As String, NewDate As String, NewPath As String
        Dim n As Integer, ct As Long
        
        Application.ScreenUpdating = False
        Application.EnableEvents = False
    
    
        Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
        With FldrPicker
          .Title = "Select the Folder With Old Workbooks"
          .AllowMultiSelect = False
            If .Show <> -1 Then GoTo NoPick
            myPath = .SelectedItems(1) & "\"
        End With
    
    
    NoPick:
        myPath = myPath
        If myPath = "" Then GoTo CleanUp
        
        myExtension = "*.xls*"
        myFile = Dir(myPath & myExtension)
        NewDate = InputBox("Please Enter the New Date For Saving")
        NewPath = InputBox("Please Enter the New Folder Path For Saving")
        If Not Right(NewPath, 1) = "\" Then NewPath = NewPath & "\"
    
    
        Do While myFile <> ""
            Set wb = Workbooks.Open(Filename:=myPath & myFile)
            DoEvents
            With ActiveWorkbook
                OldName = .Name
                n = InStr(OldName, " ")
                OldName = Left(OldName, n - 1)
                NewName = OldName & " " & NewDate
                .SaveAs Filename:=NewPath & NewName & ".xls"
                ct = ct + 1
            End With
            wb.Close SaveChanges:=True
            DoEvents
            myFile = Dir
        Loop
    
    
        MsgBox "Operation Complete!" & vbNewLine & vbNewLine & _
            ct & " Workbooks were renamed and saved to your new location."
    
    
    CleanUp:
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    
    
    End Sub

    thanks will give it a go

  5. #5
    New Member
    Join Date
    Mar 2011
    Location
    Sheffield
    Posts
    26
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Help Needed for unique task

    Quote Originally Posted by igold View Post
    How about something like this...

    Code:
    Sub RenameSaveWorkbooks()
    
    
        Dim wb As Workbook
        Dim myPath As String, myFile As String, myExtension As String
        Dim FldrPicker As FileDialog
        Dim OldName As String, NewName As String, NewDate As String, NewPath As String
        Dim n As Integer, ct As Long
        
        Application.ScreenUpdating = False
        Application.EnableEvents = False
    
    
        Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
        With FldrPicker
          .Title = "Select the Folder With Old Workbooks"
          .AllowMultiSelect = False
            If .Show <> -1 Then GoTo NoPick
            myPath = .SelectedItems(1) & "\"
        End With
    
    
    NoPick:
        myPath = myPath
        If myPath = "" Then GoTo CleanUp
        
        myExtension = "*.xls*"
        myFile = Dir(myPath & myExtension)
        NewDate = InputBox("Please Enter the New Date For Saving")
        NewPath = InputBox("Please Enter the New Folder Path For Saving")
        If Not Right(NewPath, 1) = "\" Then NewPath = NewPath & "\"
    
    
        Do While myFile <> ""
            Set wb = Workbooks.Open(Filename:=myPath & myFile)
            DoEvents
            With ActiveWorkbook
                OldName = .Name
                n = InStr(OldName, " ")
                OldName = Left(OldName, n - 1)
                NewName = OldName & " " & NewDate
                .SaveAs Filename:=NewPath & NewName & ".xls"
                ct = ct + 1
            End With
            wb.Close SaveChanges:=True
            DoEvents
            myFile = Dir
        Loop
    
    
        MsgBox "Operation Complete!" & vbNewLine & vbNewLine & _
            ct & " Workbooks were renamed and saved to your new location."
    
    
    CleanUp:
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    
    
    End Sub

    Hi thanks for the above, i ran the code and it asked for the folder location, which was good, it then asked for the "new date for saving", which i entered, it asked the same for each file in the folder (only 4 excel files); it then gave an error code

    run-time error '1004':

    Application-Define or Object-Define error

  6. #6
    Board Regular igold's Avatar
    Join Date
    Jul 2014
    Location
    Delray Beach, FL, USA
    Posts
    2,361
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Help Needed for unique task

    Do you know which line threw the error.
    ​igold

    I'm a drinker with a coding problem...

    All code is written with Excel 2010 - Please test all code on a backup copy of your data.


  7. #7
    New Member
    Join Date
    Mar 2011
    Location
    Sheffield
    Posts
    26
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Help Needed for unique task

    Quote Originally Posted by igold View Post
    Do you know which line threw the error.
    Hi, was unsure what you were asking me to do, but then figured out how to step through the code
    it stopped at line 42 Col 1

  8. #8
    Board Regular igold's Avatar
    Join Date
    Jul 2014
    Location
    Delray Beach, FL, USA
    Posts
    2,361
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Help Needed for unique task

    How about the actual line of code. Your line 42 is not necessarily my line 42...

    Also was this the entire error message

    run-time error '1004':

    Application-Define or Object-Define error
    or was there additional info provided...
    Last edited by igold; Sep 18th, 2019 at 01:38 PM.
    ​igold

    I'm a drinker with a coding problem...

    All code is written with Excel 2010 - Please test all code on a backup copy of your data.


Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •