Slight alteration to VBA code for renaming sheets

[steallan]

Hi - hoping someone better than me can help with a slight adjustment to the below code. I think its easy for someone with the skills.

So it currently opens all the files in a picked folder and renames the sheet to Sheet1, so long as there's only one sheet.

Problem is I have a combination of XLSX files and XLS files. Yes, xls files, its embarassing I know.

I'm not sure if the code will open the xls files. Can it be altered to do so if it doesnt already?

Even better, could the code be changed to, after opening the xls file and renaming the sheet, then saving the file as XLSX?

and finally, the code is more complex than I need it to be. I dont need it to open a file picker it can just run on the following folder:

\\uug.vcm.cc\Domestic_Retail\CollectionsAnalyticsTeam\DCA\Invoices\Input

sorry, I know i've asked a lot, but my VBA skills are.......well they're not really skills. Skills is too grand a term.

I'm actually using an Event in Alteryx to run vb code to open an excel and run this VBA code, then close the excel, then run my workflow! So at least I can do somethings.

Any help would be greatly appreciated.

Code:

Sub Rename()

Dim CurrentBook As Workbook
Dim ImportFiles As FileDialog
Dim FileCount As Long
Dim wbName As String

'Open File Picker
Set ImportFiles = Application.FileDialog(msoFileDialogOpen)
With ImportFiles
.AllowMultiSelect = True
.Title = "Pick Files to Adjust"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With

Application.DisplayAlerts = False
Application.DisplayAlerts = False

'Cycle through books
For FileCount = 1 To ImportFiles.SelectedItems.Count
Set CurrentBook = Workbooks.Open(ImportFiles.SelectedItems(FileCount))
wbName = Replace(CurrentBook.Name, ".xlsx", "")
CurrentBook.Activate
ActiveSheet.Name = "Sheet1"
CurrentBook.Close True
Next FileCount

Application.DisplayAlerts = True
Application.DisplayAlerts = True

End Sub

 

[gallen]

Hello. First things first is to convert all xls files to xlsx.

This code does that. Please read the caution in the code and test on a COPY of your data as this code deletes files without sending to recycle bin

Sub xls_To_xlsx()


Const sPath As String = "\\uug.vcm.cc\Domestic_Retail\CollectionsAnalyticsTeam\DCA\Invoices\Input\"


Dim sFileName As String, sFullPath As String
Dim wb As Workbook


    On Error GoTo errHandle
    sFileName = Dir(sPath & "*.xls")
    
    Do Until sFileName = ""
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        On Error Resume Next
        
        'open workbook
        Set wb = Workbooks.Open(sPath & sFileName)
        If wb Is Nothing Then
            ' nothing so failed
            MsgBox "Couldn't open " & sFileName
            Exit Sub
        End If
        
        'if we get here we have the xls file
        On Error GoTo errHandle
        'get the full string path of file without extension
        sFullPath = sPath & Replace(wb.Name, ".xls", "")
        'Save the file
        wb.SaveAs sFullPath, xlOpenXMLWorkbook
        
        '****CAUTION***
        'This line will delete without being able to undelete. Will NOT be in recycle bin
        'If unsure just remove this line and delete files manually
        Kill sPath & sFileName
        'close
        wb.Close
        'destroy variable
        Set wb = Nothing
        'get next file
        sFileName = Dir
    Loop
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
Exit Sub


'handle errors
errHandle:
    MsgBox Err.Description
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

 

[gallen]

And this code will rename the only sheet of any file with just one sheet to Sheet1. Again, ensure to test on a copy of your data as it changes the file and saves

Sub ChangeSheetName()

Const sPath As String = "H:\Test\" '"\\uug.vcm.cc\Domestic_Retail\CollectionsAnalyticsTeam\DCA\Invoices\Input\"


Dim sFileName As String, sFullPath As String
Dim wb As Workbook


On Error GoTo errHandle
    'only get xlsx files
    sFileName = Dir(sPath & "*.xlsx")
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    Do Until sFileName = ""


        On Error Resume Next
        
        'open workbook
        Set wb = Workbooks.Open(sPath & sFileName)
        If wb Is Nothing Then
            ' nothing so failed
            MsgBox "Couldn't open " & sFileName
            Exit Sub
        End If
        
        'if we get here we have the xls file
        On Error GoTo errHandle
        
        If wb.Worksheets.Count = 1 Then
            'change the name if only 1 sheet exists
            wb.Worksheets(1).Name = "Sheet1"
            wb.Save
        End If
        
        'close
        wb.Close
        'destroy variable
        Set wb = Nothing
        'get next file
        sFileName = Dir
    Loop
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
Exit Sub


'handle errors
errHandle:
    MsgBox Err.Description
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

 

[steallan]

thanks for the help gallen, you're a star.

Im just trying to run the first code, to change the xls files to xlsm. It ran fine, but i'm left with files with no file extension. xls are gone, and there's new files in their place, but no extension.


I love the way it anniliates the xls files afterwards. best thing for them

 

[steallan]

ah ha!

Showing peon vba skills i changed:

sFullPath = sPath & Replace(wb.Name, ".xls", "")

to:

sFullPath = sPath & Replace(wb.Name, ".xls", ".xlsx")

and it seems to work like a charm.

thanks again gallen, really appreciate the code help.

 

[gallen]

thanks for the help gallen, you're a star.

Im just trying to run the first code, to change the xls files to xlsm. It ran fine, but i'm left with files with no file extension. xls are gone, and there's new files in their place, but no extension.


I love the way it anniliates the xls files afterwards. best thing for them

This shouldn't have happened. This line automatically saves it with .xlsx:

[COLOR=#333333]wb.SaveAs sFullPath, xlOpenXMLWorkbook[/COLOR]

the xlOpenXMLWorkbook argument tells the line to save it as an xlsx file

 

[steallan]

i'll take the change out and try it again, tomorrow I think, got to go babysit a meeting now....

Thanks to you i'll be able to get it done. If not i'll be back. Cheers