Мне нужно получить имя файла без имени расширения с помощью VBA. Я знаю свойство ActiveWorkbook.Name
, но если у пользователя выключено свойство Windows Hide extensions for known file types
, то результатом моего кода будет [Name.Extension]. Как я могу вернуть только имя рабочей книги независимо от свойства windows?
Я пробовал даже ActiveWorkbook.Application.Caption
, но я не могу настроить это свойство.
Приведенные здесь ответы уже могут сработать в ограниченных ситуациях, но это, конечно, не лучший способ решения проблемы. Не изобретайте колесо. Объект File System Object в библиотеке Microsoft Scripting Runtime library уже имеет метод, позволяющий сделать именно это. Он называется 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
Если быть кратким, то удаление расширения демонстрируется для рабочих книг... которые теперь имеют множество расширений. Новая несохраненная Книга1 не имеет расширения. То же самое происходит и с файлами
[код]
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 [/code]
strTestString = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))
полный кредит: http://mariaevert.dk/vba/?p=162