文件扩展名验证

时间:2015-06-15 13:11:41

标签: vba

这将搜索文件名的末尾,删除其当前文件类型.docm并将其转换为.docx。效果很好。

  ActiveDocument.SaveAs2 Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1), WdSaveFormat.wdFormatXMLDocument

然而,我注意到了一个小虫子。如果有的话。在文件名中,它首先发现并且显然创建了一个不正确的文件。

例如: TestFileV1.2AlexTest.docm

成为该文件 TestFileV.2AlextTest新文件类型是.2ALEXTEST文件的位置。

一种有趣的错误,但仍然是一个错误。

验证的最佳行动方案?

谢谢!

2 个答案:

答案 0 :(得分:2)

尝试使用VBA.Strings.Split()函数,该函数将字符串拆分为数组。

将文件名拆分为'。'并且数组中的最后一个元素将是您的扩展名:

Public Function GetExtension(FileName As String) As String
'Returns a file's extension 
' This does not go to the filesystem and get the file: ' The function parses out the string after the last '.' ' Useful for situations where a file does not yet exist
' Nigel Heffernan Excellerando.Blogspot.com ' **** THIS CODE IS IN THE PUBLIC DOMAIN ****
'Print GetExtension("C:\Temp\data.txt1.docx") 'Returns docx
Dim arrayX() As String Dim iLast As Integer
    arrayX = Split(FileName, ".")     iLast = UBound(arrayX)
    GetExtension = arrayX(iLast)
    Erase arrayX
End Function

如果您不关心可读性,那么快速而肮脏的答案是:

strExt = Split(strFile, ".")(UBound(Split(strFile, ".")))

然而......我认为你正在寻找比字符串解析器更复杂的东西来提取文件扩展名。

您真的想要验证文件扩展名吗?

我没有编写用于打开文件的ShellExt应用程序命令的注册表查找,但是一年或两年前,当我需要填充文件对话框的过滤器列表时,我遇到了一个与您密切相关的问题。任意文件扩展名列表。

它没有“验证”,但未知扩展将返回包含“未知文件类型”的字符串,您可以测试它:

VBA和注册表:从文件扩展名返回文件类型

Public Function GetExtensionType(strExt As String) As String
' Return a file extension type descriptor, if the OS knows it ' Parses out the string after the last "." and reads the registry
' GetExtensionType("txt")                   Returns 'Text Document' ' GetExtensionType("SystemORA.user.config") 'XML Configuration File' ' GetExtensionType("Phishy.vbs")            'VBScript Script File'

' Nigel Heffernan Excellerando.Blogspot.com ' **** THIS CODE IS IN THE PUBLIC DOMAIN ****

On Error GoTo ErrSub
Dim strType As String Dim strTyp1 As String Dim strTyp2 As String
strExt = Trim(strExt)
' Set a default return: if an error is raised, return this value GetExtensionType = Trim(strExt & " (unknown file type)")
strExt = Split(strExt, ".")(UBound(Split(strExt, ".")))  '
If strExt = "" Then     Exit Function End If
With CreateObject("WScript.Shell")
'   This will go to error if there's no key for strExt in HKCR     strTyp1 = .RegRead("HKCR." & strExt & "\")
    If strTyp1 = "" Then         strType = strExt & " File"     Else     '   This value isn't very readable, eg: Access.ACCDEFile.14     '   But we can use it to retrieve a descriptive string:         strTyp2 = .RegRead("HKCR\" & strTyp1 & "\")                  If strTyp2 = "" Then         '   So we didn't get a descriptive string:         '   Parse some readability out of strType1:             strType = strTyp1             strType = Replace(strType, "File", " File")             strType = Replace(strType, ".", " ")         Else             strType = strTyp2         End If              End If      End With
If strType <> "" Then     GetExtensionType = strType End If
ExitSub:     Exit Function ErrSub:     Resume ExitSub
End Function

我让它容忍错误,但我没有打扰这个傻瓜,因为有人在某个地方正在建立一个更好的白痴;并且完全有可能用户实际上是正确的,因为确实存在调用的文件,并且我的系统没有相关文件类型的注册表项。

代码中存在明显的错误来源:GetExtensionType("docx")将在英语工作站上为您提供“Microsoft Word文档”。如果您的用户群正在使用其他语言和区域设置,他们将以所选语言查看描述性名称“Microsoft Word文档”;您编码的任何验证逻辑都将无法匹配该字符串(当然,除非您的字符串文字在条件编译器块中国际化)。

因此,对预定义的应用程序名称或文件类型的任何验证都需要位于注册表的与语言无关的层,使用来自根的'strTyp1'而不是传递给'strTyp2'的依赖于语言环境的字符串。

答案 1 :(得分:0)

使用Scripting Runtime中的FileSystemObject - 它有一个.GetBaseName()方法从文件路径中提取基本名称:

'Early bound (reference to Microsoft Scripting Runtime):
Dim fso As New FileSystemObject
ActiveDocument.SaveAs2 fso.GetBaseName(ActiveDocument.Name), WdSaveFormat.wdFormatXMLDocument

'Late bound:
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
ActiveDocument.SaveAs2 fso.GetBaseName(ActiveDocument.Name), WdSaveFormat.wdFormatXMLDocument

您还可以使用.GetExtensionName()方法检索扩展程序,使用.GetParentFolderName()检索路径,使用GetDriveName()检索驱动器号(也可以使用UNC路径)。

如果您需要在当前的Windows安装中找到扩展名的注册名称,您可以使用@Nile回答的注册表方法或AssocQueryStringA的API调用:

Const ASSOCSTR_FRIENDLYDOCNAME = 3

Private Declare Function AssocQueryString Lib "shlwapi.dll" _
    Alias "AssocQueryStringA" ( _
    ByRef Flags As Long, _
    ByVal str As Long, _
    ByVal pszAssoc As String, _
    ByVal pszExtra As String, _
    ByVal pszOut As String, _
    ByRef pcchOut As Long) As Long

Sub Main()

    Dim buffer As String
    buffer = String$(255, " ")
    Dim hresult As Long
    hresult = AssocQueryString(0, ASSOCSTR_FRIENDLYDOCNAME, ".docm", _
                               vbNullString, buffer, 255)

    If hresult = 0 Then
        'Should be something like "Microsoft Word Macro-Enabled Document"
        Debug.Print Trim$(buffer)
    End If

End Sub

请注意,您还可以通过为str参数传递不同的值来检索有关相关文件类型的附加信息。请参阅ASSOCSTR枚举。