Vba excel получить имя файла без расширения

I need to get file name without extension name by VBA. I know ActiveWorkbook.Name property , but if user haves Windows property Hide extensions for known file types turn off, the result of my code will be [Name.Extension]. How can I return only name of Workbook independent of windows property?

I try even ActiveWorkbook.Application.Caption but I can’t customize this property.

This gets the file type as from the last character (so avoids the problem with dots in file names)

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))

End Function

answered Feb 20, 2019 at 16:05

This thread has been very helpful to me lately. Just to extend on the answer by @RubberDuck, the File System Object in the Microsoft Scripting Runtime library is already there to achieve this. Also if you define it as an Object as below, it will save you the hassle of having to enable ‘Microsoft Scripting Runtime’ in VBA Tools > References:

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Debug.Print fso.GetBaseName(ActiveWorkbook.Name)

In this way it will return name of the ActiveWorkbook without extension.

There is another way by using INSTRREV function as below:

Dim fname As String
fname = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
MsgBox fname

Both will return the same result. Also in both of the methods above, they will retain any full-stops in the file name and only get rid of the last full-stop and the file extension.

answered Jun 29, 2022 at 18:02

To be verbose it the removal of extension is demonstrated for
workbooks.. which now have a variety of extensions .
. a new unsaved Book1 has no ext
. works the same for files

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

I use a macro from my personal.xlsb and run it on both xlsm and xlsx files so a variation on David Metcalfe’s answer that I use is

Dim Wrkbook As String

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

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

answered Apr 6, 2021 at 14:04

Here is a solution if you do not want to use FSO.
There were some similar answers before, but here some checks are done to handle multiple dots in name and name without extension.

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

answered May 2, 2022 at 16:37