Имя файла без расширения VBA
Мне нужно получить имя файла без расширения имени VBA. я знаю ActiveWorkbook.Name свойство, но если у пользователя есть свойство Windows Hide extensions for known file types выключите, результатом моего кода будет [Name.Extension]. Как я могу вернуть только имя Workbook независимо от свойства windows?
Я стараюсь даже ActiveWorkbook.Application.Caption но я не могу настроить это свойство.
11 ответов
strTestString = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))
полный кредит: http://mariaevert.dk/vba/?p=162
Ответы, приведенные здесь, уже могут работать в ограниченных ситуациях, но, безусловно, не лучший способ сделать это. Не изобретай велосипед. Объект файловой системы в библиотеке времени выполнения сценариев Microsoft уже имеет метод, позволяющий сделать именно это. Это называется 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
Просто, но у меня хорошо работает
FileName = ActiveWorkbook.Name
If InStr(FileName, ".") > 0 Then
FileName = Left(FileName, InStr(FileName, ".") - 1)
End If
На мой взгляд, использование функции 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
В последнее время мне очень помогла эта тема. Чтобы расширить ответ @RubberDuck, объект файловой системы в библиотеке Microsoft Scripting Runtime уже существует для достижения этой цели. Кроме того, если вы определите его как объект , как показано ниже, это избавит вас от необходимости включать «Среду выполнения сценариев Microsoft» в Инструменты VBA> Ссылки :
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Debug.Print fso.GetBaseName(ActiveWorkbook.Name)
Таким образом, он вернет имя ActiveWorkbook без расширения.
Существует еще один способ использования функции INSTRREV, как показано ниже:
Dim fname As String
fname = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
MsgBox fname
Оба вернут один и тот же результат. Кроме того, в обоих описанных выше методах они сохранят все точки в имени файла и избавятся только от последней точки и расширения файла.
Это получает тип файла, начиная с последнего символа (поэтому избегает проблемы с точками в именах файлов)
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))
Конечная функция
Вы всегда можете использовать
Replace() поскольку вы выполняете это с именем книги, которое почти наверняка закончится на
.xlsm в силу использования VBA.
Используя ActiveWorkbook в вашем примере:
Replace(Application.ActiveWorkbook.Name, ".xlsm", "")
Используя ThisWorkbook:
Replace(Application.ThisWorkbook.Name, ".xlsm", "")
Я использую макрос из моего файла personal.xlsb и запускаю его как для файлов xlsm, так и для файлов xlsx, поэтому вариант ответа Дэвида Меткалфа, который я использую,
Dim Wrkbook как строка
Wrkbook = Заменить (Application.ActiveWorkbook.Name, «.xlsx», «.pdf»)
Wrkbook = Заменить (Application.ActiveWorkbook.Name, «.xlsm», «.pdf»)
Вот решение, если вы не хотите использовать FSO. Раньше было несколько похожих ответов, но здесь выполняются некоторые проверки для обработки нескольких точек в имени и имени без расширения.
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
Чтобы быть многословным, удаление расширения продемонстрировано для рабочих книг, которые теперь имеют множество расширений., новый несохраненный Book1 не имеет доп. работает одинаково для файлов
[код]
Функция WorkbookIsOpen(FWNa$, необязательный 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
Конечная функция [/code]
Ответ здесь: я думаю, что этот ответ хорош, пожалуйста, попробуйте его http://mariaevert.dk/vba/?p=162