Страницы: 1
RSS
Пересохранить файл в ту же папку с тем же именем
 
Здравствуйте, уважаемые!

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

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

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

Когда открываешь csv и нажимаешь сохранить как, меняешь формат, имя фала сохраняется как у открытого.
И путь как у исходного
Нужно повторить данную процедуру макросом
 
Цитата
MaxVM написал: Да это может быть абсолютно любой csv
Ну у меня, например, ни одного CSV нет. Предлагаете ради Вас что-то создать, записать макрос и его же для Вас унифицировать?  
Согласие есть продукт при полном непротивлении сторон
 
Вот файл
 
Код
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
Согласие есть продукт при полном непротивлении сторон
 
Спасибо!!! то что нужно!!!
 
Чуть проще:
Код
Sub www()
    With ActiveWorkbook
        .SaveAs .Path & "\" & Left(.Name, InStrRev(.Name, ".") - 1) & ".xls", 56
    End With
End Sub
Я сам - дурнее всякого примера! ...
 
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
 
Цитата
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
 
Цитата
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 (теги забыл)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
abricos29, а по какому признаку, если не по последней точке, ищет расширение файла команда
Код
Name = FSO.GetExtensionName("Q:\aaa\bred\MySuperFile.txt")

Поделитесь. До кончика хвоста любопытно.
 
Дмитрий(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
 
Цитата
написал:
Здравствуйте, уважаемые!Подскажите пожалуйста.Есть файл в csv, нужно макросом пересохранить в файл xls (97-2010) в туже папку с темже именемЗаписываю но прописываются пути, как чделать его универсальным не знаю. Спасибо!
NewName = "РАСЧЕТ" & "_" & Range("a4") & "_" & Range("a6") & "_" & "мультик" & " " & "x" & Range("E6") & "-" & Range("E4") & " " & "шт" & ".xlsm"
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & NewName

Новое имя набирается из ячеек указанных в макросе. В данном примере название файла "Расчет" а остальное переменные данные которые находятся в нужных ячейках
Страницы: 1
Наверх