我创建了一对可重复使用的子例程，这些子例程一起工作以根据需要保存不同扩展名的文件。
第一个Sub接收目录路径，文件名和所需的Excel扩展名。然后它调用第二个Sub来查找正确的Excel FileFormat数字并使用它以新格式保存文件：
Sub SaveFileWithNewExtension(DirectoryPath As String, NameOfFile As String, ExtensionToUse As String)
Dim ExcelFileFormatNumber As String
GetExcelFormatNumber ExtensionToUse, ExcelFileFormatNumber
ActiveWorkbook.SaveAs DirectoryPath & "\" & NameOfFile & ExtensionToUse, FileFormat:=ExcelFileFormatNumber
End Sub
第二个子主要是我将使用的Excel FileFormats的参考。对于FileFormat引用，我将FileFormat Number和Name存储在一个键入不同文件扩展名的数组中，所有这些都存储在我可以根据需要添加的集合中：
Sub GetExcelFormatNumber(Extension As String, Optional Number As String, Optional ExcelFormat As String)
'http://msdn.microsoft.com/en-us/library/office/ff198017.aspx
'http://www.rondebruin.nl/mac/mac020.htm
Dim ExtensionReference As New Collection
ExtensionReference.Add Array("51", "xlOpenXMLWorkbook"), ".xlsx"
ExtensionReference.Add Array("52", "xlOpenXMLWorkbookMacroEnabled"), ".xlsm"
ExtensionReference.Add Array("50", "xlExcel12"), ".xlsb"
ExtensionReference.Add Array("56", "xlExcel8"), ".xls"
On Error GoTo NoMatch:
ExcelFormat = ExtensionReference.Item(Extension)(1)
Number = ExtensionReference.Item(Extension)(0)
Exit Sub
NoMatch:
msgbox "No Matching Extension was Found in the ExcelExtensionsAndNumbers Collection"
End Sub
将数组保存在这样的集合中似乎相当笨重而且不优雅，这让我觉得我已经这么做了。
这是我的问题： 是否有更好的方法来存储信息，如供其他潜艇使用？或者用另一种方式表达：你是否有一种最喜欢抽象数据的方式（比如本例中的FileFormat代码），所以它可以重复使用而不必每次都记住和重写它？
代码已被修改为使用案例而不是集合，以更好地处理错误（正如Siddharth Rout重写代码所建议的那样）。这是有效的，案例结构对我的眼睛更有意义：
Public Sub SaveFileWithNewExtension(DirectoryPath As String, NameOfFile As String, ExtensionToUse As String)
Dim ExcelFileFormatNumber As String
GetExcelFormatNumber ExtensionToUse, ExcelFileFormatNumber
If ExcelFileFormatNumber <> "" Then
ActiveWorkbook.SaveAs DirectoryPath & "\" & NameOfFile & ExtensionToUse, FileFormat:=ExcelFileFormatNumber
Else
msgbox "Invalid file extension. Case does not exist."
End If
End Sub
Public Sub GetExcelFormatNumber(ExtensionToFind As String, Optional Number As String, Optional ExcelFormat As String)
'reference - http://msdn.microsoft.com/en-us/library/office/ff198017.aspx
'reference - http://www.rondebruin.nl/mac/mac020.htm
Select Case ExtensionToFind
Case ".xlsx": Number = "51"
ExcelFormat = "xlOpenXMLWorkbook"
Case ".xlsm": Number = "52"
ExcelFormat = "xlOpenXMLWorkbookMacroEnabled"
Case ".xlsb": Number = "50"
ExcelFormat = "xlExcel12"
Case ".xls": Number = "56"
ExcelFormat = "xlExcel8"
Case ".csv": Number = "6"
ExcelFormat = "xlCSV"
Case Else: Number = ""
ExcelFormat = ""
End Select
End Sub
答案 0 :(得分：1)
我同意。对于4个Extns，数组将是一个过度杀伤。我宁愿在函数中使用Select Case。见下文
UNTESTED
Sub SaveFileWithNewExtension(DirectoryPath As String, _
NameOfFile As String, _
ExtensionToUse As String)
Dim ExcelFileFormatNumber As Long
ExcelFileFormatNumber = GetExcelFormatNumber(ExtensionToUse)
If ExcelFileFormatNumber <> 0 Then
ActiveWorkbook.SaveAs _
DirectoryPath & _
"\" & _
NameOfFile & ExtensionToUse, _
FileFormat:=ExcelFileFormatNumber
Else
MsgBox "Invalid Extenstion:"
End If
End Sub
Function GetExcelFormatNumber(Extn As String) As Long
'~~> FileFormat
Select Case UCase(Extn)
Case "XLS": GetExcelFormatNumber = 56
Case "XLSX": GetExcelFormatNumber = 51
Case "XLSM": GetExcelFormatNumber = 52
Case "XLSB": GetExcelFormatNumber = 56
'~~> Add for more... like csv etc
End Select
End Function
答案 1 :(得分：0)
这是一个相当普遍的解决方案（从Excel 2010开始）：
Function GetFileFormat(FileExt As String) As Long
'Converts the specified file-extension string to its corresponding file-format code value, if known. If the
'file-format value for the specified extension is unknown, then a zero value is returned.
'
'WARNING: some extension strings map to multiple possible file-format values. Such ambiguous specifications
'are handled according to the following priority:
'
' 1) If the ambiguity is related to older vs. more recent versions of the file type, such as xlDBF4
' vs. xlDBF3 vs. xlDBF2, the most recent version is returned (xlDBF4).
'
' 2) If the ambiguity is related to more general vs. more specific versions of the file type, such as
' xlCurrentPlatformText vs. xlTextMSDOS vs. xlTextWindows and there is a Excel version-specific default
' option (xlCurrentPlatformText in this case) then the version-specific default is returned.
'
' 3) If the ambiguity is related to more general vs. more specific versions and there is no Excel version-
' specific default, such as xlCSV vs. xlCSVMSDOS vs. xlCSVWindows, the most general version is returned
' (xlCSV).
'
' 4) "xls" files present a special case of all of the above. See the code commentary for that
' case, below.
'
' If you need a different default conversion, then edit the code accordingly.
'
'NOTE: Though they should all work in theory, based on the available reference documentation, not all of
' these conversions have been tested (as of August 2014)!
'
'AUTHOR: Peter Straton
'
'*************************************************************************************************************
'The following FileFormat constants are available in all versions from Excel 2003 onward, so they are listed
'here for reference but there is no need to actually declare them. If there is a possibility of running this
'code under an earlier version of Excel, then experiment and un-comment any undefined constants.
'Const xlAddIn As Long = 18 '.xla
'Const xlAddIn8 As Long = 18 '.xla
'Const xlCSV As Long = 6 '.csv
'Const xlCSVMac As Long = 22 '.csv
'Const xlCSVMSDOS As Long = 24 '.csv
'Const xlCSVWindows As Long = 23 '.csv
'Const xlCurrentPlatformText As Long = -4158 '.txt
'Const xlDBF2 As Long = 7 '.dbf
'Const xlDBF3 As Long = 8 '.dbf
'Const xlDBF4 As Long = 11 '.dbf
'Const xlDIF As Long = 9 '.dif
'Const xlExcel12 As Long = 50 '.xlsb
'Const xlExcel2 As Long = 16 '.xls
'Const xlExcel2FarEAst As Long = 27 '.xls
'Const xlExcel3 As Long = 29 '.xls
'Const xlExcel4 As Long = 33 '.xls
'Const xlExcel4Workbook As Long = 35 '.xlw
'Const xlExcel5 As Long = 39 '.xls
'Const xlExcel7 As Long = 39 '.xls
'Const xlExcel8 As Long = 56 '.xls
'Const xlExcel9795 As Long = 43 '.xls
'Const xlHtml As Long = 44 '.htm, .html
'Const xlIntlAddIn As Long = 26 '
'Const xlIntlMacro As Long = 25 '
'Const xlNormal As Long = -4143 '
'Const xlOpenDocumentSpreadsheet As Long = 60 '.ods
'Const xlOpenXMLAddIn As Long = 55 '.xlam
'Const xlOpenXMLTemplate As Long = 54 '.xltx
'Const xlOpenXMLTemplateMacroEnabled As Long = 53 '.xltm
'Const xlOpenXMLWorkbook As Long = 51 '.xlsx
'Const xlOpenXMLWorkbookMacroEnabled As Long = 52 '.xlsm
'Const xlSYLK As Long = 2 '.slk
'Const xlTemplate As Long = 17 '.xlt
'Const xlTemplate8 As Long = 17 '.xlt
'Const xlTextMac As Long = 19 '.txt
'Const xlTextMSDOS As Long = 21 '.txt
'Const xlTextPrinter As Long = 36 '.prn
'Const xlTextWindows As Long = 20 '.txt
'Const xlUnicodeText As Long = 42 '.txt
'Const xlWebArchive As Long = 45 '.mht, .mhtml
'Const xlWJ2WD1 As Long = 14 '
'Const xlWJ3 As Long = 40 '
'Const xlWJ3FJ3 As Long = 41 '
'Const xlWK1 As Long = 5 '.wk1
'Const xlWK1ALL As Long = 31 '.wk1
'Const xlWK1FMT As Long = 30 '.wk1
'Const xlWK3 As Long = 15 '.wk3
'Const xlWK3FM3 As Long = 32 '.wk3
'Const xlWK4 As Long = 38 '.wk4
'Const xlWKS As Long = 4 '.wks
'Const xlWorkbookDefault As Long = 51 '.xlsx
'Const xlWorkbookNormal As Long = -4143 '
'Const xlWorks2FarEAst As Long = 28 '.wks
'Const xlWQ1 As Long = 34 '.wq1
'Const xlXMLData As Long = 47 '.xml
'Const xlXMLSpreadsheet As Long = 46 '.xml
'The following FileFormat constants are not available in any versions of Excel up to and including Excel 2010,
'(VBA7) so declare them in all cases.
Const xlOpenXMLStrictWorkbook As Long = 61 '.??? (Exists in Excel 2013 and later versions)
Const UnsupportedPDF As Long = 57 'As of 8/2014, this value works while debugging in VBE but
'fails otherwise!
'The following FileFormat constants are not available in versions of Excel prior to Excel 2007 (VBA7),
'so declare them in all versions earlier than VBA7.
#If VBA7 = 0 Then 'Can't use the "Not" operator since defined built-in compiler constants evaluate
'to 1 (&H0001), not True (&HFFFF). So (Not 1) = &HFFFE, which is also True since it
'isn't &H0000 (False).
Const xlAddIn8 As Long = 18 '.xla
Const xlExcel12 As Long = 50 '.xlsb
Const xlExcel8 As Long = 56 '.xls
Const xlOpenDocumentSpreadsheet As Long = 60 '.ods
Const xlOpenXMLAddIn As Long = 55 '.xlam
Const xlOpenXMLTemplate As Long = 54 '.xltx
Const xlOpenXMLTemplateMacroEnabled As Long = 53 '.xltm
Const xlOpenXMLWorkbook As Long = 51 '.xlsx
Const xlOpenXMLWorkbookMacroEnabled As Long = 52 '.xlsm
Const xlTemplate8 As Long = 17 '.xlt
Const xlWorkbookDefault As Long = 51 '.xlsx
#End If
'Though web references suggest xlXMLData should be defined in Excel 2003 (VBA6) only, it isn't actually
'defined in my copy of VBA6, running under Excel 2003. So don't actually restrict this declaration to
'versions later than Excel 2003.
' #If VBA6 = 0 And VBA7 = 1 Then 'All versions later than Excel 2003 (See note about "Not" operator, above)
Const xlXMLData As Long = 47 '.xml
' #End If
Select Case UCase(Replace(FileExt, ".", ""))
Case "CSV": GetFileFormat = xlCSV
Case "DBF": GetFileFormat = xlDBF4
Case "DIF": GetFileFormat = xlDIF
Case "HTM": GetFileFormat = xlHtml
Case "HTML": GetFileFormat = xlHtml
Case "MHT": GetFileFormat = xlWebArchive
Case "MHTML": GetFileFormat = xlWebArchive
Case "ODS": GetFileFormat = xlOpenDocumentSpreadsheet
Case "PDF": GetFileFormat = UnsupportedPDF
Case "PRN": GetFileFormat = xlTextPrinter
Case "SLK": GetFileFormat = xlSYLK
Case "TXT": GetFileFormat = xlCurrentPlatformText
Case "WK1": GetFileFormat = xlWK1ALL
Case "WK3": GetFileFormat = xlWK3FM3
Case "WK4": GetFileFormat = xlWK4
Case "WKS": GetFileFormat = xlWKS
Case "WQ1": GetFileFormat = xlWQ1
Case "XLA": GetFileFormat = xlAddIn
Case "XLAM": GetFileFormat = xlOpenXMLAddIn
Case "XLS"
If CInt(Application.Version) >= Excel_2007_VNum Then
'Excel 2007 and later versions:
GetFileFormat = xlExcel8 '= 56, an ".xls" file
Else
'Excel 2003:
'The xlExcel8 value (56) isn't actually recognized by Excel versions 8 through 11 (Excel 97
'through 2003), so use of it will fail. And, the default used when the SaveAs method's
'FileFormat argument isn't defined (for either a new file or existing) is the file format
'of the last successfully saved file, whatever that might be! (Note that Excel VBA Help is
'misleading on this point.) So, in this case, return xlNormal (-4143) which always defaults
'to an ".xls" file type when the code is run under Excel 2003 and earlier versions.
GetFileFormat = xlNormal 'defaults to an ".xls" file
End If
Case "XLSB": GetFileFormat = xlExcel12
Case "XLSM": GetFileFormat = xlOpenXMLWorkbookMacroEnabled
Case "XLSX": GetFileFormat = xlOpenXMLWorkbook
Case "XLT": GetFileFormat = xlTemplate
Case "XLTM": GetFileFormat = xlOpenXMLTemplateMacroEnabled
Case "XLTX": GetFileFormat = xlOpenXMLTemplate
Case "XLW": GetFileFormat = xlExcel4Workbook
' Case "XML": GetFileFormat = xlXMLData 'Which would be the best default?
Case "XML": GetFileFormat = xlXMLSpreadsheet ' "
End Select
#If Mac Then
If CInt(Application.Version) > Excel_Mac2011_VNum Then
'This code is running on a Mac and this is Excel 2011 or a later version
'Per Ron de Bruin @http://www.rondebruin.nl/mac/mac020.htm, in Excel 2011 (Mac) you must add 1 to
'each FileFormat value. [Untested]
FileFormatCode = FileFormatCode + 1
End If
#End If
End Function
正如代码中所述，所有转换都应该在理论上基于可用的参考文档工作，但并非所有转换都经过测试（截至2014年8月）。任何有关彻底测试的帮助将不胜感激。如果发现任何错误的转换，请在此处发布回复，并将更正更正。