Open an Excel file and save as .XLS

问题

I have the following code, I want it to open my files which are saved as .xlsx and simply save them again with the same filename but this time as a .xls file so that they are compatible with Excel 2003

Set app = CreateObject("Excel.Application")
Set fso = CreateObject("Scripting.FileSystemObject")

For Each f In fso.GetFolder("Y:\Billing_Common\autoemail").Files
  If LCase(fso.GetExtensionName(f)) = "xlsx" Then
    Set wb = app.Workbooks.Open(f.Path)

app.DisplayAlerts = False

wb.SaveAs "*.xls*"
wb.Close SaveChanges=True
app.Close
app.Quit

  End if

Set f = Nothing
Set fso = Nothing
Next

回答1:

As Bathsheba already pointed out, Set fso = Nothing and app.Quit belong at the end of the script (outside the loop). There are some more bugs, though.

• wb.SaveAs "*.xls*"

  You can't save a workbook to a wildcard name. If you want to save the workbook under its current name, just use wb.Save. Otherwise you'll have to use an explicit name (you should also set the filetype then):

  wb.SaveAs "new.xlsx", 51
  

  or

  wb.SaveAs "C:\path\to\new.xls", -4143
  

• wb.Close SaveChanges=True

  VBScript doesn't support named parameters (see here). If you want to call the Close method with the SaveChanges parameter set to True you have to do it like this:

  wb.Close True
  

• app.Close

  The application object doesn't have a Close method.

Not bugs, but things worth improving:

• app.DisplayAlerts = False should go before the loop starts unless you re-enable it inside the loop as well.

• I'd recommend adding a line app.Visible = False after you create the application object. When you have to debug your script you can simply change that value to True to show the application on your desktop. That helps a lot with finding bugs.

Fixed-up script:

Set app = CreateObject("Excel.Application")
app.Visible = False
app.DisplayAlerts = False

Set fso = CreateObject("Scripting.FileSystemObject")

For Each f In fso.GetFolder("Y:\Billing_Common\autoemail").Files
  If LCase(fso.GetExtensionName(f)) = "xlsx" Then
    Set wb = app.Workbooks.Open(f.Path)

    wb.Save
    wb.Close True
  End if
Next

app.Quit
Set app = Nothing
Set fso = Nothing

回答2:

Two serious bugs:

• Set fso = Nothing should not be inside your loop: you'll need fso for the duration of the program.

• Also, drop app.Quit from the loop; keep Excel open until the very
  end.

Set f = Nothing is unnecessary (although benign); let the loop pick the values for you.

回答3:

Dim app, fso, file, fName, wb, dir 

dir = "d:\path\"

Set app = CreateObject("Excel.Application")
Set fso = CreateObject("Scripting.FileSystemObject")

For Each file In fso.GetFolder(dir).Files
    If LCase(fso.GetExtensionName(file)) = "xlsx" Then  
    fName = fso.GetBaseName(file)

    Set wb = app.Workbooks.Open(file) 
    app.Application.Visible = False
    app.Application.DisplayAlerts = False
    app.ActiveWorkbook.SaveAs dir & fName & ".xls", 43
    app.ActiveWorkbook.Close 
    app.Application.DisplayAlerts = True 
    app.Application.Quit 

    End if
Next

Set fso = Nothing
Set wb = Nothing    
Set app = Nothing

wScript.Quit

来源：https://stackoverflow.com/questions/17464698/open-an-excel-file-and-save-as-xls