» Excel VBA (часть 3)

mrdime

Цитата:

раз вылазит назойливое сообщение

Наверняка это сообщение можно как-то отключить.

Переименовать файл просто изменив расширение это не решение проблемы. Файлы 2007 и 2003 отличаются кроме названия еще и структурой, которая естественно при переименовании не меняется. Поэтому и орет эксель на левое название которое не соответствует содержанию.
mrdime
Microsoft File Format Converters бесплатная прога от майкрософта которая позволяет открывать файлы 2007 офиса в 2003. Просто и без всякого конверта.

JekG, зачем так усложнять? Нужно же просто расширение файла сменить, и все - а это банальным батником делается, безо всяких VBA/VBScript

ZlydenGL
Ну смотря какая стоит задача. Если просто переименовать то да, а вот если полноценно с ними работать да еще чтоб их открыл и 2007 офис при необходимости отут проблема. Но эт в любом случае не в этот топик.

JekG, дык вообще-то такая задача и стоит, ибо

Цитата:

прога, из которой экспортируется информация, экспортирует данные в формате .xml, но физически файлу присваивается расширение .xls. (так вот криво реализовали разработчики).

А дальше все просто - если генерация производится при помощи компоненты офиса 2007 - то надо просто поменять расширение на xlsx, если при помощи офиса 2003 - то на xls и все, задача решена - Excel ругаться при открытии уже ни на что не будет.

ZlydenGL
Ты не понял. Они уже переименованы в .xls, как я писал выше, и Эксел как раз и ругается на неверный формат. Проблема их всех програмно переконвертить в .xlsx, чтобы дальше нормально работать.

mrdime, пардон, стормозил. Ну тогда переименовывай расширение обратно в XML - с этим форматом MS Excel 2007 вроде бы работает без проблем? Или тебе важно именно нативный формат получить?

JekG
Файлконвертор мне не нужен. Office 2007 (который у меня установлен) сам все прекрасно делает.
ZlydenGL
С .xml - на самом деле работает нормально. Но хотелы бы работать все-же с файлами в его родном формате .xlsx
Т.е. вариантов обхода есть, но хотелось бы это сделать програмно.

mrdime, тогда через VBA/VBScript вызывай


Код: Set WB = Workbooks.Open "filename.xml"
WB.SaveAs "filename.xlsx", fileformat = 52
WB.Close

ZlydenGL
Если можно: немного ликбеза. Со скриптами я никогда не работал раньше.
Какой файл создавать? С каким расширением? Это все можно делать просто из блокнота?

mrdime
Сервис/Макрос/Начать запись потом Остановить запись Потом Сервис/Макрос/Макросы выбрать Макрос1 нажать редактировать и в тело вставить код от ZlydenGL
в таком виде


Код: Sub Макрос1()
Set WB = Workbooks.Open "filename.xml"
WB.SaveAs "filename.xlsx", fileformat = 52
WB.Close
End Sub

JekG
Сорри, тупанул.

Не понимаю почему, но выдает ошибку в строке
Set WB = Workbooks.Open "filename.xml"
Вместо "filename.xml" вставляю текстовую переменную. Хотя в любом случае выдает ошибку сразу же.

mrdime, а переменную WB как Workbook объявил?

ZlydenGL
Объявил.
Все равно ошибку выдает.
Чтобы всем было понятно, что и как. Привожу свой код в сыром (т.е. пока неработающем виде)

Sub ChangeFull_xls()

Dim iDotPos As Integer
Dim iSlashPos As Integer
Dim ExpFileName As String
Dim DirName As String
Dim File_Name(1 To 20) As String
Dim FileList As String
Dim I As Integer
Dim WB As Workbook

ExpFileName = ActiveWorkbook.Name
I = 1
File_Name(I) = Dir("")
Do
I = I + 1
File_Name(I) = Dir
Loop Until File_Name(I) = ""

For Y = 1 To I - 1
iDotPos = InStrRev(File_Name(Y), ".")
Set WB = Workbooks.Open FileName:= File_Name(Y)
ExpFileName = Left$(ExpFileName, iDotPos - 1) + ".xlsx"
WB.SaveAs ExpFileName, FileFormat = 52
WB.Close
Next Y

End Sub

Красным - выделена ошибка.
Т.е. макрос, ищет все файлы в папке с активным (открытым) файлом, записывает их в массив. Потом все файлы по-очереди открываются и конвертируются.

mrdime, жесть полная Чем тебя фукнция Dir() так обидела, что ты ее так хитропятоточково пользуешь?

Добавлено:
Правильней будет так:


Код: Sub ChangeFull_xls()
Dim FName As String
Dim WB As Workbook
Dim iDotPos Integer
Dim ExpFileName As String

Fname = Dir(Thisworkbook.Path & "\*.xls")
While FName<>""
iDotPos = InStrRev(FName(Y), ".")
Set WB = Workbooks.Open(FName)
ExpFileName = Left(FName, iDotPos - 1) + ".xlsx"
WB.SaveAs ExpFileName, FileFormat = 52
WB.Close
FName=Dir()
Wend
End Sub

Создаем батник в нужной папке


Код: echo off
ren *.xml *.xlsx

JekG, дык при этом же Ёксель будет ругаться, что форматы не совпадают?

ZlydenGL
Спасибо большое за подсказки и правки.

Цитата:

Чем тебя фукнция Dir() так обидела

Я VBA в основном "методом тыка" изучаю. Где-то Help почитал, где-то кусок какой-то статьи. Посему многого не знаю.
Доработал твой код:

Цитата:

Sub ChangeFull_new_xls()

Dim FName As String
Dim WB As Workbook
Dim iDotPos As Integer
Dim ExpFileName As String

FName = Dir(ActiveWorkbook.Path & "\*.xls")
While FName <> ""
iDotPos = InStrRev(FName, ".")
ExpFileName = FName
Set WB = Workbooks.Open(ActiveWorkbook.Path + "\" + FName)
ExpFileName = Left$(ExpFileName, iDotPos - 1) + ".xlsx"
WB.SaveAs ExpFileName, FileFormat = 52
WB.Close
FName = Dir()
Wend
End Sub

На этапе SaveAs возникает ошибка 1004: "Method 'Save As' of object '_Workbook' failed."
В чем может быть проблема?

mrdime, привыкай вместо ActiveWorkBook пользовать все-таки ThisWorkbook, так намного надежней и удобней.

Почему не работает SaveAs - проще уже разбирать тебе Открой MSDN, может я просто неправильно описал его вызов. Или попробуй написать так:


Код: WB.SaveAs ExpFileName, FileFormat := 52

ZlydenGL

Цитата:

привыкай вместо ActiveWorkBook пользовать все-таки ThisWorkbook

ThisWorkbook не катит, т.к. почему-то активной становится не папка файла из которого пошел вызов макроса, а папка, в которой находится мой файл с макросами Personal.xlsb и соответственно поиск идет уже в ней (что мне совершенно не нужно).
Когда использую ActiveWorkBook - такого не происходит.
Насчет:

Цитата:

FName & "x"

Просто отличная идея! Я зациклился на "стандартных" методах.

Добавлено
Все. Уже разобрался.
Привожу доработанный код. Может кому-нибудь пригодится на будущее.

Цитата:

Sub ChangeFull_new_xls()
Dim FName As String
Dim WB As Workbook
Dim iDotPos As Integer
Dim DirPath As String

FName = Dir(ActiveWorkbook.Path & "\*.xls")
DirPath = ActiveWorkbook.Path + "\"
While FName <> ""
If Right$(FName, 5) <> ".xlsx" Then
Set WB = Workbooks.Open(DirPath + FName)
WB.SaveAs DirPath & FName & "x", FileFormat:=xlOpenXMLWorkbook
WB.Close
End If
FName = Dir()
Wend
End Sub

Единственное с чем пока не разобрался: как убрать назойливое сообщение при открытии первого файла о несоответствии форматов.

mrdime, понятно, я предполагал, что у тебя файл скрипта лежит в той же папке, что и файлы экспорта. Тогда лучше путь хранить либо в переменной, либо (если чистый VBA пользуешь) - на ячейке листа (куда ее выводить можно опять же стандартным диалогом Open) или запрашивать перед каждым запуском (с применением того же диалога).

Кстати, а не проще ли файл со скриптом положить в ту же папку, где файлы экспорта хранятся, а ЯРЛЫК на него - уже куда удобно?

ZlydenGL
У меня много разных макросов. В разных папках хранить неудобно, посему все обитают в файле Personal.xlsb. Всегда все под рукой.
Всякие диалоговые окна замедляют процесс работы - думай, куда и что вписывать. А так - нажал кнопку - и все готово.

Цитата:

а не проще ли файл со скриптом положить в ту же папку, где файлы экспорта хранятся,

На каждую дату создается отдельная папка, соответственно каждый раз папка разная. Поэтому предложенный вариант не годится.

mrdime, тоже дело А папка с данными за дату случаем не только этой датой отличается? Тогда ее проще забить на автовычисление через Now()

ZlydenGL

Цитата:

А папка с данными за дату случаем не только этой датой отличается?

Да, отличие только в дате. Какая дата, такая и папка. Сегодня 28.01, значит папка - 28.

Цитата:

Тогда ее проще забить на автовычисление через Now()

Идею не понял. Разъясни пожалуйста.

mrdime, все просто. Предположим, что часть пути, куда производится выгрузка - константа, например общий путь до папки с данными. Пусть это будет


Код: ConstPath = "H:\Data\Export\xml\"

ZlydenGL
Супер! Спасибо. Отличная идея.
Сейчас реализуем.
К стати, а не проще ли вместо такой хитромудрой комбинации использовать просто функцию Date$?
Она на американский манер выдает текстовую строку вида "ММ-ДД-ГГГГ".
Добавлено
По ходу возник вопрос.
Придется создавать каждый раз новую директорию.
Какой командой это реализовать?
И можно ли удалить програмно старые файлы?
Чего-то не нашел команды Delete для объектов в VBA Excel.

mrdime

Цитата:

Придется создавать каждый раз новую директорию.
Какой командой это реализовать?

Dim SourceFolder As String, DestinationFolder As String, ce As Range
InitialPath = ThisWorkbook.Path: Application.ScreenUpdating = False
SourceFolder = GetFolderPath("Выберите исходную папку для поиска файлов", InitialPath)
If SourceFolder = "" Then MsgBox "Необходимо указать папку!", vbCritical, "Папка не выбрана": Exit Sub


Цитата:

И можно ли удалить програмно старые файлы?
Чего-то не нашел команды Delete для объектов в VBA Excel.

Kill SourceFolder & file

mrdime, а зачем создавать новые директории? Механизм выгрузки, написанный "криворучками", куда файлы складывает? Или он их в общую свалку кладет?

mrdime

Цитата:

Придется создавать каждый раз новую директорию.
Какой командой это реализовать?

Код: MkDir strPath & Format$(Date, "dd.mm.yy")

JekG
В моем случае лучше автоматом создавать директорию по текущей дате.
Кроме того (может я чего-то не понял), но я не вижу в приведенном тобой коде процесс создания директории. Данный код лишь предлагает выбрать папку, а необходимо именно
создать.

Цитата:

Kill SourceFolder & file

Спасибо, а можно этой командой грохнуть только файлы? Исходная папка постоянная и ее удалять не желательно.
ZlydenGL

Цитата:

а зачем создавать новые директории? Механизм выгрузки, написанный "криворучками", куда файлы складывает? Или он их в общую свалку кладет?

Экспорт идет поштучно/ пофайлово.
Прога предлагает выбрать папку для экспорта. Т.е. все равно придется ее создавать руками.
Поэтому у меня механизм такой. По-умолчанию файлы скопом экспортируются в папку программы (чтобы каждый раз не прописывать ее руками). После экспорта всех файлов, первый попвашийся файл открываю руками, запускаю макрос - запускается механизм конвертации, и одновременно должна создаваться папка (с названием по текущей дате) в моей рабочей директории куда переконвертированные файлы будут копироваться. После окончания процесса конвертации, макрос должен удалить старые файлы с расширением .xls. Вот так я решил развить идею.

vlth
Спасибо за подсказку!
Теперь все задачи выполняются.
Осталось разобраться только, как удалить старые файлы с расширением .xls.