| |
Прежде всего установите ссылку на Microsoft
Scripting Runtime через меню Project | References.
Вызов функции прост: ChangeExtension "путь к
папке", "новое_расширение_файла", ""
Пример: ChangeExtension "D:\1\2", "htm", ""
В данном примере используются функции
определения имени файла с расширением и без.
Public Function ChangeExtension(ByVal FolderName As String,
ByVal NewExtension As String, OldExtension As String) As Boolean
Dim oFso As New FileSystemObject
Dim oFolder As Folder
Dim oFile As File
Dim sOldName As String
Dim sNewName As String
Dim iCtr As Long
Dim iDotPosition As Integer
Dim sWithoutExt As String
Dim sFolderName As String
sFolderName = FolderName
If Right(sFolderName, 1) <> "\" Then sFolderName = sFolderName &
"\"
Set oFolder = oFso.GetFolder(FolderName)
'перебор каждого файла в указанной папке
For Each oFile In oFolder.Files
sOldName = sFolderName & oFile.Name 'старый путь/имя файла
sNewName = sFolderName & Spliting1(Spliting(oFile.Name, "\"), ".")
& "." & NewExtension 'новое имя файла
'файл с новым именем уже может существовать
On Error Resume Next
Name sOldName As sNewName
Err.Clear
On Error GoTo ErrorHandler
Next
ChangeExtension = True
ErrorHandler:
Set oFile = Nothing
Set oFolder = Nothing
Set oFso = Nothing
End Function'функция Spliting определяет
полное имя файла
'функция Spliting1 определяет только имя файла
Private Function Spliting(sFullPath As String, point As String)
Dim str1() As String
str1 = Split(sFullPath, point)
Spliting = str1(UBound(str1))
End Function
Private Function Spliting1(sFullPath As String, point As String)
Dim str1() As String
str1 = Split(sFullPath, point)
Spliting1 = str1(0)
End Function
Private Sub Command1_Click()
'ChangeExtension "D:\1\2", "htm", "txt"
ChangeExtension "D:\1\2", "htm", ""
End Sub
|
|