Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Пересохранить файл в ту же папку с тем же именем
 
#1
25.07.2017 13:32:44
Здравствуйте, уважаемые!

Подскажите пожалуйста.
Есть файл в csv, нужно макросом пересохранить в файл xls (97-2010) в туже папку с темже именем

Записываю но прописываются пути, как чделать его универсальным не знаю.

Спасибо!
 
 
 
#2
25.07.2017 13:35:28
Цитата
MaxVM написал:
как чделать его универсальным не знаю.
Так Вы его хоть покажите здесь. Из чего делать-то?
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
25.07.2017 13:37:59
Да это может быть абсолютно любой csv
Просто 1 в 1

Когда открываешь csv и нажимаешь сохранить как, меняешь формат, имя фала сохраняется как у открытого.
И путь как у исходного
Нужно повторить данную процедуру макросом
 
 
 
#4
25.07.2017 13:40:56
Цитата
MaxVM написал: Да это может быть абсолютно любой csv
Ну у меня, например, ни одного CSV нет. Предлагаете ради Вас что-то создать, записать макрос и его же для Вас унифицировать?  
Согласие есть продукт при полном непротивлении сторон
 
 
 
#5
25.07.2017 13:42:12
Вот файл
 
 
 
#6
25.07.2017 14:06:18
Код
Sub csvTOxls()
With ActiveWorkbook
    BaseName = CreateObject("Scripting.FileSystemObject").GetBaseName(.Path & Application.PathSeparator & .Name)
    .SaveAs Filename:=.Path & Application.PathSeparator & BaseName & ".xls", FileFormat:=xlExcel8
End With
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
25.07.2017 14:10:05
Спасибо!!! то что нужно!!!
 
 
 
#8
25.07.2017 14:42:08
Чуть проще:
Код
Sub www()
    With ActiveWorkbook
        .SaveAs .Path & "\" & Left(.Name, InStrRev(.Name, ".") - 1) & ".xls", 56
    End With
End Sub
Я сам - дурнее всякого примера! ...
 
 
 
#9
25.07.2017 14:46:34
Sanja, просто пошутил
Код
Sub qq()
    With ActiveWorkbook
        .SaveAs Left$(.FullName, InStrRev(.FullName, ".") - 1), 56
    End With
End Sub

Код
Sub qqq()
    With ActiveWorkbook
        .SaveAs Replace(.FullName, ".csv", ".xls"), 56
    End With
End Sub
 
 
 
#10
23.01.2019 19:49:43
Цитата
kuklp написал:
Sub csvTOxls()With ActiveWorkbook    BaseName = CreateObject("Scripting.FileSystemObject").GetBaseName(.Path & Application.PathSeparator & .Name)    .SaveAs Filename:=.Path & Application.PathSeparator & BaseName & ".xls", FileFormat:=xlExcel8End WithEnd Sub
Уважаемые kuklp и RAN, позволю себе небольшую ремарку, всё же ваши варианты не так универсальны, как вариант Sanja из поста #6, если в имени файла будут присутствовать точки, помимо той, что отделяет имя от расширения, то итог будет неверным. Единственное, что я бы сократил в коде из поста #6 так это вместо GetBaseName(.Path & Application.PathSeparator & .Name) использовать GetBaseName(.FullName)
Код
Sub AnyExtTOxls()
With ActiveWorkbook
BaseName = CreateObject("Scripting.FileSystemObject").GetBaseName(.FullName)
.SaveAs Filename:=.Path & Application.PathSeparator & BaseName & ".xls", FileFormat:=xlExcel8
End With
End Sub
 
 
 
#11
23.01.2019 20:00:29
Цитата
abricos29 написал:
если в имени файла будут присутствовать точки, помимо той, что отделяет имя от расширения
Эта точка должна быть тогда в самом расширении, т.к. InStrRev ищет СПРАВА налево. Т.е. от конца строки к левой её части. Что 100% дает точку, разделяющую имя файла и расширение. Потестируйте такой пример:
Код
Sub yyyy()
Dim s As String
s = "файл.точка.точка.тире.xlsx"
Debug.Print Left$(s, InStrRev(s, ".") - 1)
End Sub

Как видно, точки нам нисколько не мешают.
А FSO для такой простой задачи слишком нагружает процесс, т.к. обращение к сторонней библиотеке весьма затратный процесс и не всегда оправдан.
Изменено: Дмитрий(The_Prist) Щербаков - 23.01.2019 20:01:03 (теги забыл)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#12
23.01.2019 21:39:23
abricos29, а по какому признаку, если не по последней точке, ищет расширение файла команда
Код
Name = FSO.GetExtensionName("Q:\aaa\bred\MySuperFile.txt")

Поделитесь. До кончика хвоста любопытно.
 
 
 
#13
24.01.2019 05:40:40
Дмитрий(The_Prist) Щербаков и RAN  - каюсь, свою ошибку осознал, имя файла с любым количеством точек действительно определяется верно, про ресурсоёмкость сторонней библиотеки понял, но всё же первый код из поста #9 сохраняет файл хоть и с правильным именем, но без расширения. Дополнил код.
Код
Sub qq()
    With ActiveWorkbook
        .SaveAs Left$(.FullName, InStrRev(.FullName, ".") - 1) & ".xls", 56
    End With
End Sub
Изменено: abricos29 - 24.01.2019 06:47:16
 
 
 
#14
14.05.2024 11:51:33
Цитата
написал:
Здравствуйте, уважаемые!Подскажите пожалуйста.Есть файл в csv, нужно макросом пересохранить в файл xls (97-2010) в туже папку с темже именемЗаписываю но прописываются пути, как чделать его универсальным не знаю. Спасибо!
Изменено: val_kaz - 01.08.2024 18:20:36 (не правильный ответ)
 
 
 
Страницы: 1
Наверх