File name without extension name VBA

Question

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.

Answer 1

The answers given here already may work in limited situations, but are certainly not the best way to go about it. Don't reinvent the wheel. The File System Object in the Microsoft Scripting Runtime library already has a method to do exactly this. It's called GetBaseName. It handles periods in the file name as is.

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 2

Simple but works well for me

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

Answer 3

Using the Split function seems more elegant than InStr and Left, in my opinion.

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 4

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

Answer 5

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

Answer 6

You could always use Replace() since you're performing this on the workbook's Name, which will almost certainly end with .xlsm by virtue of using VBA.

Using ActiveWorkbook per your example:

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

Using ThisWorkbook:

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

Answer 7

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

Answer 8

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

Answer 9

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

full credit: http://mariaevert.dk/vba/?p=162