locked
open excel workbooks and save them as an xls file (stick with me) RRS feed

  • Question

  • Hey Guys, 

    So we have an issue where several hundred excel workbooks, are being treated as .HTM or .HTML files. For Example if you open the file in excel, it gives you the file type mismatch warning, then if you go to save it, it pops up with an error "Do you want to save this as a web page". 

    This all came about because were running the readiness toolkit for an office application upgrade and several hundred excel files, failed to be recognized by the readiness toolkit. (inaccessible)

    So what i need to do is to open up several hundred excel files, then save them as an XLS file, overwriting the current one on disk. I found this code here, but am not really clear on how well it will work or if i just have it misunderstood. 

    VBA

    set xls = CreateObject("Excel.Application")
    xls.DisplayAlerts = False

    set fso = CreateObject("Scripting.FileSystemObject")
    set w_shell = CreateObject("WScript.Shell")

    desktop = w_shell.SpecialFolders("Desktop")
    folder_path = fso.GetAbsolutePathName(desktop) & "\Payroll\"

    set folder = fso.GetFolder(folder_path)
    set files = folder.Files

    for each file in files
        path = folder_path & file.Name
        set workbook = xls.Workbooks.Open(path)
        path = Replace(path, "xlsx", "csv")
        workbook.SaveAs path, 6
        workbook.Close False
    next

    xls.Quit

    additionally if i open the in excel, and manually save it, then run the readiness toolkit on the file it works as expected. 

    Any ideas? 

    Thanks, 

    Robert 


    Robert

    • Moved by Bill_Stewart Tuesday, June 30, 2020 10:18 PM Move to more appropriate forum
    Tuesday, June 30, 2020 10:03 PM

All replies

  • To:  Windows Engineering
    re: saving files with new extension

    Do not run the code you found.
    It appears to save the files to a Desktop folder named payroll.
    That is after changing the file extension to .CSV.

    What is the current file extension on the files?
    Are all of the files in the same folder?
    What happens if you just change the file extension and not save the file?
    '---



    Free Excel programs at MediaFire (no ads)...
    http://www.mediafire.com/folder/lto3hbhyq0hcf/Documents

    Thursday, July 2, 2020 3:46 AM
  • Thanks for the response. 

    The files are not in the same folder, but are in various folders under a parent folder. Such as: 

    C:\files\group1\files1.xls

    C:\files\Group2\Files2.xls

    C:\files\Group2\business\files3.xls

    The files are currently XLS Flies, and ideally they would need to be either re-saved as .xls files or really as .xlsx files.

    if you rename the file extension to .xlsx it fails, with the same error the only way to fix the file is to open it up (filenames.xls) and re-save it as filenames.xls (or another name).xls/.xlsx. 

    Also i have not run the code as described in my original post. as i do not really understand it, so didn't run it. 

    Thanks, 

    Robert 


    Robert

    Thursday, July 2, 2020 3:57 AM
  • To:  Robert
    re:  saving files with new extension

    Below is code that works for me.
    Please note the line that says "Change THIS".
      You must specify the parent folder for the files you want changed.

    I set up a new folder "temp" and put  a couple of .xls files in it and then
    added another folder to that folder with a couple more files.

    I strongly recommend you do something similar to test the code on your system
    before attacking several hundred files.
    The new .xlsx files are sent to the default folder on my system, your result may be different.

    Note: a file count of saved files is displayed in the status bar while the code is running.

    Here goes...
    '---
    Sub NewFilesToFolder()
     'Nothing Left to Lose - Portland, Oregon USA - July 2020
      Dim strPath As String
      Dim oFSO    As Object
      Dim oFile   As Object
      Dim oFolder As Object
      Dim strName As String
      Dim FileCount As Long
      Dim WB As Excel.Workbook
      strPath = "C:\temp"     '<<<<< CHANGE THIS
     
      Set oFSO = VBA.CreateObject("Scripting.FileSystemObject")
      Set oFolder = oFSO.GetFolder(strPath)
      Application.ScreenUpdating = False
      For Each oFile In oFolder.Files
        If oFile.Name Like "*.xls" Then
         strName = VBA.Replace(oFile.Name, "xls", "xlsx")
         Set WB = Application.Workbooks.Open(Filename:=strPath & _
                  Application.PathSeparator & oFile.Name, UpdateLinks:=False)
         WB.SaveAs Filename:=strName
         Application.Workbooks(strName).Close savechanges:=False
         FileCount = FileCount + 1
         Application.StatusBar = "File count " & FileCount
        End If
      Next 'oFile
     
      Call AllSubFolderFiles(oFolder, FileCount)   '<<<This calls the function below.
     
      Set WB = Nothing
      Set oFSO = Nothing
      Set oFile = Nothing
      Set oFolder = Nothing
      Application.StatusBar = False
    End Sub
    '---
    Function AllSubFolderFiles(ByRef oParentFolder As Object, ByRef FileCount As Long)
      Dim oSubFolder As Object
      Dim oFile As Object
      Dim strName As String
      Dim strPath As String
      Dim WB As Excel.Workbook
     
      For Each oSubFolder In oParentFolder.SubFolders
       strPath = oSubFolder.Path
       For Each oFile In oSubFolder.Files
        If oFile.Name Like "*.xls" Then
         strName = VBA.Replace(oFile.Name, "xls", "xlsx")
         Set WB = Application.Workbooks.Open(Filename:=strPath & _
                  Application.PathSeparator & oFile.Name, UpdateLinks:=False)
         WB.SaveAs Filename:=strName
         Application.Workbooks(strName).Close savechanges:=False
         FileCount = FileCount + 1
        End If
        Application.StatusBar = "File count " & FileCount
       Next 'oFile
       Call AllSubFolderFiles(oSubFolder, FileCount)   '<<<Uses recursion, it calls itself
      Next   'oSubFolder
    End Function
    '---

    Free Excel programs at MediaFire (no ads)...
    http://www.mediafire.com/folder/lto3hbhyq0hcf/Documents




    • Edited by Nothing Left to Lose Thursday, July 2, 2020 2:10 PM Moved "End If" down two rows to ensure accurate file count
    Thursday, July 2, 2020 6:00 AM
  • Ok thanks I will take a look at this and do some testing. 

    Robert


    Robert

    Thursday, July 2, 2020 12:59 PM