不带扩展名的文件名 VBA

Question

我需要通过 VBA 获取不带扩展名的文件名。我知道 ActiveWorkbook.Name 属性，但如果用户关闭 Windows 属性 Hide extensions for known file types，我的代码的结果将是 [Name.Extension]。我如何才能 return 仅独立于 windows 属性的工作簿名称？

我什至尝试 ActiveWorkbook.Application.Caption 但我无法自定义此属性。

Answer 1

strTestString = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))

满分：http://mariaevert.dk/vba/?p=162

Answer 2

此处给出的答案可能已经在有限的情况下起作用，但肯定不是解决问题的最佳方法。不要重新发明轮子。 File System Object in the Microsoft Scripting Runtime library already has a method to do exactly this. It's called GetBaseName。它按原样处理文件名中的句点。

Public Sub Test()

    Dim fso As New Scripting.FileSystemObject
    Debug.Print fso.GetBaseName(ActiveWorkbook.Name)

End Sub

Public Sub Test2()

    Dim fso As New Scripting.FileSystemObject
    Debug.Print fso.GetBaseName("MyFile.something.txt")

End Sub

Instructions for adding a reference to the Scripting Library

Answer 3

为了详细说明，删除了扩展名工作簿.. 现在有各种扩展。 .新的未保存的 Book1 没有分机号 .对文件工作相同

Function WorkbookIsOpen(FWNa$, Optional AnyExt As Boolean = False) As Boolean

Dim wWB As Workbook, WBNa$, PD%
FWNa = Trim(FWNa)
If FWNa <> "" Then
    For Each wWB In Workbooks
        WBNa = wWB.Name
        If AnyExt Then
            PD = InStr(WBNa, ".")
            If PD > 0 Then WBNa = Left(WBNa, PD - 1)
            PD = InStr(FWNa, ".")
            If PD > 0 Then FWNa = Left(FWNa, PD - 1)
            '
            ' the alternative of using split..  see commented out  below
            ' looks neater but takes a bit longer then the pair of instr and left
            ' VBA does about 800,000  of these small splits/sec
            ' and about 20,000,000  Instr Lefts per sec
            ' of course if not checking for other extensions they do not matter
            ' and to any reasonable program
            ' THIS DISCUSSIONOF TIME TAKEN DOES NOT MATTER
            ' IN doing about doing 2000 of this routine per sec

            ' WBNa = Split(WBNa, ".")(0)
            'FWNa = Split(FWNa, ".")(0)
        End If

        If WBNa = FWNa Then
            WorkbookIsOpen = True
            Exit Function
        End If
    Next wWB
End If

End Function

Answer 4

简单但很适合我

FileName = ActiveWorkbook.Name 
If InStr(FileName, ".") > 0 Then 
   FileName = Left(FileName, InStr(FileName, ".") - 1) 
End If

Answer 5

在我看来，使用 Split 函数似乎比 InStr 和 Left 更优雅。

Private Sub CommandButton2_Click()


Dim ThisFileName As String
Dim BaseFileName As String

Dim FileNameArray() As String

ThisFileName = ThisWorkbook.Name
FileNameArray = Split(ThisFileName, ".")
BaseFileName = FileNameArray(0)

MsgBox "Base file name is " & BaseFileName

End Sub

Answer 6

这从最后一个字符开始获取文件类型（因此避免了文件名中的点问题）

Function getFileType(fn As String) As String

''get last instance of "." (full stop) in a filename then returns the part of the filename starting at that dot to the end
Dim strIndex As Integer
Dim x As Integer
Dim myChar As String

strIndex = Len(fn)
For x = 1 To Len(fn)

    myChar = Mid(fn, strIndex, 1)

    If myChar = "." Then
        Exit For
    End If

    strIndex = strIndex - 1

Next x

getFileType = UCase(Mid(fn, strIndex, Len(fn) - x + 1))

结束函数

Answer 7

您始终可以使用 Replace()，因为您是在工作簿的名称上执行此操作，由于使用 VBA.[=14=，它几乎肯定会以 .xlsm 结尾]

根据您的示例使用 ActiveWorkbook：

Replace(Application.ActiveWorkbook.Name, ".xlsm", "")

使用本工作簿：

Replace(Application.ThisWorkbook.Name, ".xlsm", "")

Answer 8

我在 xlsm 和 xlsx 文件上都使用了 personal.xlsb 和运行中的宏，所以我使用的 David Metcalfe 答案的变体是

Dim Wrkbook As String

Wrkbook = Replace(Application.ActiveWorkbook.Name, ".xlsx", ".pdf")

Wrkbook = Replace(Application.ActiveWorkbook.Name, ".xlsm", ".pdf")

Answer 9

如果您不想使用 FSO，这里有一个解决方案。之前有一些类似的回答，不过这里做了一些检查来处理name和name中的多个点而不带扩展名。

Function getFileNameWithoutExtension(FullFileName As String)

    Dim a() As String
    Dim ext_len As Integer, name_len As Integer


    If InStr(FullFileName, ".") = 0 Then
       getFileNameWithoutExtension = FullFileName
       Exit Function
    End If
    
    a = Split(ActiveWorkbook.Name, ".")
    ext_len = Len(a(UBound(a))) 'extension length (last element of array)
    name_len = Len(FullFileName) - ext_len - 1 'length of name without extension and a dot before it
    getFileNameWithoutExtension = Left(FullFileName, name_len)
    
End Function

Sub test1() 'testing the function
 MsgBox (getFileNameWithoutExtension("test.xls.xlsx")) ' -> test.xls
 MsgBox (getFileNameWithoutExtension("test")) ' -> test
 MsgBox (getFileNameWithoutExtension("test.xlsx")) ' -> test
End Sub

不带扩展名的文件名 VBA

File name without extension name VBA

excel

vba