Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Удаление одинаковых файлов с разным расширением - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление одинаковых файлов с разным расширением (Макросы/Sub)
Удаление одинаковых файлов с разным расширением
ZamoK Дата: Вторник, 09.01.2018, 12:03 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
С Новым годом!
на дворе 9 января и голова плохо соображает %)
Суть вопроса: в папке D:\картинки\ ну очень много картинок, есть и одинаковые, но .jpg .tif .png. нужно обнаружить одинаковые и удалить файлы .tif и .png если есть такой же .jpg
Хотелось бы это макросом провернуть, ну или может кто подскажет где похожая тема обсуждалась, я что-то не нашёл. Спасибо


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеС Новым годом!
на дворе 9 января и голова плохо соображает %)
Суть вопроса: в папке D:\картинки\ ну очень много картинок, есть и одинаковые, но .jpg .tif .png. нужно обнаружить одинаковые и удалить файлы .tif и .png если есть такой же .jpg
Хотелось бы это макросом провернуть, ну или может кто подскажет где похожая тема обсуждалась, я что-то не нашёл. Спасибо

Автор - ZamoK
Дата добавления - 09.01.2018 в 12:03
TimSha Дата: Вторник, 09.01.2018, 12:27 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 591
Репутация: 91 ±
Замечаний: 0% ±

Excel 2013 Pro +
[offtop]В нете полно различных киллеров дубликатов и чистильщиков для фото и пр. медиа - с какого боку вы хотите пристегнуть к этому XL?![/offtop]


"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Ответить
Сообщение[offtop]В нете полно различных киллеров дубликатов и чистильщиков для фото и пр. медиа - с какого боку вы хотите пристегнуть к этому XL?![/offtop]

Автор - TimSha
Дата добавления - 09.01.2018 в 12:27
ZamoK Дата: Вторник, 09.01.2018, 12:39 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
ну как сказать с какого боку? Если мыслить более масштабно это могут быть не только картинки, а макрос потому что мне интересен алгоритм действия по конкретному условию работы с одним и тем же списком файлов, а это реальная задача и минимум объяснений, что хотелось бы получить в итоге. Вот как-то так.


Я не Гуру, но стремлюсь!
 
Ответить
Сообщениену как сказать с какого боку? Если мыслить более масштабно это могут быть не только картинки, а макрос потому что мне интересен алгоритм действия по конкретному условию работы с одним и тем же списком файлов, а это реальная задача и минимум объяснений, что хотелось бы получить в итоге. Вот как-то так.

Автор - ZamoK
Дата добавления - 09.01.2018 в 12:39
bmv98rus Дата: Вторник, 09.01.2018, 13:11 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 1323
Репутация: 223 ±
Замечаний: 0% ±

Excel 2013/2016
ZamoK,
Все просто - перебор всех файлов в конкретном каталоге (или через DIR или Filesytem object) при этом в DIR можно сразу оставить фильтр *.JPEG. Далее берется имя и удаляется файл с таким именем но с расширением .tif и .png с отключением ошибки на эту операцию на случай если файла нет. ну тили с проверкой на то что он есть.
 
Ответить
СообщениеZamoK,
Все просто - перебор всех файлов в конкретном каталоге (или через DIR или Filesytem object) при этом в DIR можно сразу оставить фильтр *.JPEG. Далее берется имя и удаляется файл с таким именем но с расширением .tif и .png с отключением ошибки на эту операцию на случай если файла нет. ну тили с проверкой на то что он есть.

Автор - bmv98rus
Дата добавления - 09.01.2018 в 13:11
anvg Дата: Вторник, 09.01.2018, 14:24 | Сообщение № 5
Группа: Друзья
Ранг: Обитатель
Сообщений: 402
Репутация: 213 ±
Замечаний: 0% ±

2010, 2016
Доброе время суток.
Далее берется имя и удаляется файл с таким именем но с расширением .tif и .png
Если критерий "одинаковости" именно в этом, то может быть. А вдруг, там жена сохранила фотку с именем Я.jpeg, муж сохранил я.tiff и сын - Я.png? Достаточено ли как критерий "одинаковости" имя файла?
 
Ответить
СообщениеДоброе время суток.
Далее берется имя и удаляется файл с таким именем но с расширением .tif и .png
Если критерий "одинаковости" именно в этом, то может быть. А вдруг, там жена сохранила фотку с именем Я.jpeg, муж сохранил я.tiff и сын - Я.png? Достаточено ли как критерий "одинаковости" имя файла?

Автор - anvg
Дата добавления - 09.01.2018 в 14:24
ZamoK Дата: Вторник, 09.01.2018, 14:44 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Короче спасибо за помощь как-то так наверное да?
попробовал вроде сработало, по грамотности написания поправьте, может что не так?
Сработал мгновенно и плохо что удалил мимо мусорки, т.е. без возможности восстановить теперь репу чешу , а правильно ли отработал макрос?
Нельзя работать 9 января.....
Нельзя !....


Я не Гуру, но стремлюсь!

Сообщение отредактировал ZamoK - Вторник, 09.01.2018, 14:59
 
Ответить
СообщениеКороче спасибо за помощь как-то так наверное да?
попробовал вроде сработало, по грамотности написания поправьте, может что не так?
Сработал мгновенно и плохо что удалил мимо мусорки, т.е. без возможности восстановить теперь репу чешу , а правильно ли отработал макрос?
Нельзя работать 9 января.....
Нельзя !....

Автор - ZamoK
Дата добавления - 09.01.2018 в 14:44
ZamoK Дата: Вторник, 09.01.2018, 15:10 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Поправил так будет лучше:

В любом случае
Нельзя работать 9 января.....
Нельзя !....


Я не Гуру, но стремлюсь!

Сообщение отредактировал ZamoK - Вторник, 09.01.2018, 15:11
 
Ответить
СообщениеПоправил так будет лучше:

В любом случае
Нельзя работать 9 января.....
Нельзя !....

Автор - ZamoK
Дата добавления - 09.01.2018 в 15:10
bmv98rus Дата: Вторник, 09.01.2018, 15:11 | Сообщение № 8
Группа: Проверенные
Ранг: Старожил
Сообщений: 1323
Репутация: 223 ±
Замечаний: 0% ±

Excel 2013/2016
anvg, Андрей, рад снова встретить тут. персональный ПК он и ест персональный, чтоб никого там ...... :-)

теперь репу чешу , а правильно ли отработал макрос?

Просто считайте что правильно :-) , берегите нервы.
Но на будущее конечно надо при отладке удаление коментить. Лог писать ну и не удялять, а временно переносить.


Сообщение отредактировал bmv98rus - Вторник, 09.01.2018, 15:13
 
Ответить
Сообщениеanvg, Андрей, рад снова встретить тут. персональный ПК он и ест персональный, чтоб никого там ...... :-)

теперь репу чешу , а правильно ли отработал макрос?

Просто считайте что правильно :-) , берегите нервы.
Но на будущее конечно надо при отладке удаление коментить. Лог писать ну и не удялять, а временно переносить.

Автор - bmv98rus
Дата добавления - 09.01.2018 в 15:11
ZamoK Дата: Вторник, 09.01.2018, 15:28 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
при этом в DIR можно сразу оставить фильтр *.JPEG.

грусть БОЛЬшая грусть - нет фильтра! Улетели файлы в единичном виде .tif .png.


Я не Гуру, но стремлюсь!
 
Ответить
Сообщение
при этом в DIR можно сразу оставить фильтр *.JPEG.

грусть БОЛЬшая грусть - нет фильтра! Улетели файлы в единичном виде .tif .png.

Автор - ZamoK
Дата добавления - 09.01.2018 в 15:28
bmv98rus Дата: Вторник, 09.01.2018, 15:38 | Сообщение № 10
Группа: Проверенные
Ранг: Старожил
Сообщений: 1323
Репутация: 223 ±
Замечаний: 0% ±

Excel 2013/2016
собственно и понятно
при этом в DIR можно сразу оставить фильтр *.JPEG
не зря писано было.

Смотрите проги по восстановлению удаленных файлов. они еще живы.

ну и на случай с карзинкой
[vba]
Код
sFolderPath = "c:\temp\"
dDateDif = DateAdd("d", -7, Date)
sExt = "txt"

Set fso = CreateObject("Scripting.FileSystemObject")
Set recyclebin = CreateObject("Shell.Application").Namespace(10)

For Each oFile In fso.GetFolder(sFolderPath).Files
    If oFile.DateLastModified < dDateDif And LCase(fso.GetExtensionName(oFile.Name)) = LCase(sExt) Then   
  recyclebin.MoveHere(oFile.Path)
  WScript.Sleep 10
    End If
Next
[/vba]


Сообщение отредактировал bmv98rus - Вторник, 09.01.2018, 15:42
 
Ответить
Сообщениесобственно и понятно
при этом в DIR можно сразу оставить фильтр *.JPEG
не зря писано было.

Смотрите проги по восстановлению удаленных файлов. они еще живы.

ну и на случай с карзинкой
[vba]
Код
sFolderPath = "c:\temp\"
dDateDif = DateAdd("d", -7, Date)
sExt = "txt"

Set fso = CreateObject("Scripting.FileSystemObject")
Set recyclebin = CreateObject("Shell.Application").Namespace(10)

For Each oFile In fso.GetFolder(sFolderPath).Files
    If oFile.DateLastModified < dDateDif And LCase(fso.GetExtensionName(oFile.Name)) = LCase(sExt) Then   
  recyclebin.MoveHere(oFile.Path)
  WScript.Sleep 10
    End If
Next
[/vba]

Автор - bmv98rus
Дата добавления - 09.01.2018 в 15:38
ZamoK Дата: Вторник, 09.01.2018, 15:42 | Сообщение № 11
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Файлы восстановил с бекапа... , не соображу как фильтр воткнуть?


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеФайлы восстановил с бекапа... , не соображу как фильтр воткнуть?

Автор - ZamoK
Дата добавления - 09.01.2018 в 15:42
bmv98rus Дата: Вторник, 09.01.2018, 15:46 | Сообщение № 12
Группа: Проверенные
Ранг: Старожил
Сообщений: 1323
Репутация: 223 ±
Замечаний: 0% ±

Excel 2013/2016
[vba]
Код
Set coll = FilenamesCollection(folder$, "*.jp*")
[/vba]
 
Ответить
Сообщение[vba]
Код
Set coll = FilenamesCollection(folder$, "*.jp*")
[/vba]

Автор - bmv98rus
Дата добавления - 09.01.2018 в 15:46
ZamoK Дата: Вторник, 09.01.2018, 15:51 | Сообщение № 13
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
В этом случае в коллекцию не попадают другие расширения, а как их тогда удалить?


Я не Гуру, но стремлюсь!

Сообщение отредактировал ZamoK - Вторник, 09.01.2018, 15:51
 
Ответить
СообщениеВ этом случае в коллекцию не попадают другие расширения, а как их тогда удалить?

Автор - ZamoK
Дата добавления - 09.01.2018 в 15:51
bmv98rus Дата: Вторник, 09.01.2018, 16:00 | Сообщение № 14
Группа: Проверенные
Ранг: Старожил
Сообщений: 1323
Репутация: 223 ±
Замечаний: 0% ±

Excel 2013/2016
ZamoK, у вас же тут как раз реализовано что я написал ранее ,[vba]
Код
        fName = Left(ИмяФайла, InStrRev(ИмяФайла, ".") - 1)
If ИмяФайла = fName & ".tif" Then
Kill folder$ & "\" & ИмяФайла
End If
If ИмяФайла = fName & ".png" Then
Kill folder$ & "\" & ИмяФайла
[/vba]
удаляются именно ".tif и .png с именем fName = Left(ИмяФайла, InStrRev(ИмяФайла, ".") - 1)


Сообщение отредактировал bmv98rus - Вторник, 09.01.2018, 16:00
 
Ответить
СообщениеZamoK, у вас же тут как раз реализовано что я написал ранее ,[vba]
Код
        fName = Left(ИмяФайла, InStrRev(ИмяФайла, ".") - 1)
If ИмяФайла = fName & ".tif" Then
Kill folder$ & "\" & ИмяФайла
End If
If ИмяФайла = fName & ".png" Then
Kill folder$ & "\" & ИмяФайла
[/vba]
удаляются именно ".tif и .png с именем fName = Left(ИмяФайла, InStrRev(ИмяФайла, ".") - 1)

Автор - bmv98rus
Дата добавления - 09.01.2018 в 16:00
ZamoK Дата: Вторник, 09.01.2018, 16:03 | Сообщение № 15
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Да, НО если есть только файл ххх.tif, а xxx.jpg нет файла, то удаляется единственный ххх.tif - это фиаско...

Надо как-то перед удалением проверку на наличие Имяфайла & ".jpg" делать, а вот как не соображу %)


Я не Гуру, но стремлюсь!

Сообщение отредактировал ZamoK - Вторник, 09.01.2018, 16:07
 
Ответить
СообщениеДа, НО если есть только файл ххх.tif, а xxx.jpg нет файла, то удаляется единственный ххх.tif - это фиаско...

Надо как-то перед удалением проверку на наличие Имяфайла & ".jpg" делать, а вот как не соображу %)

Автор - ZamoK
Дата добавления - 09.01.2018 в 16:03
ZamoK Дата: Вторник, 09.01.2018, 16:09 | Сообщение № 16
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Т.е. если в коллекции есть ИмяФайла & ".jpg", то давай удалим Имяфайла & ".tif" или Имяфайла & ".png" - Как это правильно записать?


Я не Гуру, но стремлюсь!

Сообщение отредактировал ZamoK - Вторник, 09.01.2018, 16:10
 
Ответить
СообщениеТ.е. если в коллекции есть ИмяФайла & ".jpg", то давай удалим Имяфайла & ".tif" или Имяфайла & ".png" - Как это правильно записать?

Автор - ZamoK
Дата добавления - 09.01.2018 в 16:09
nilem Дата: Вторник, 09.01.2018, 17:10 | Сообщение № 17
Группа: Авторы
Ранг: Старожил
Сообщений: 1478
Репутация: 519 ±
Замечаний: 0% ±

Excel 2013
ZamoK, привет
попробуйте так:


Яндекс.Деньги 4100159601573
 
Ответить
СообщениеZamoK, привет
попробуйте так:

Автор - nilem
Дата добавления - 09.01.2018 в 17:10
Karataev Дата: Вторник, 09.01.2018, 17:16 | Сообщение № 18
Группа: Проверенные
Ранг: Старожил
Сообщений: 1256
Репутация: 485 ±
Замечаний: 0% ±

Excel


Киви-кошелек: 9166309108
Яндекс-деньги: 410014131888288
 
Ответить
Сообщение

Автор - Karataev
Дата добавления - 09.01.2018 в 17:16
ZamoK Дата: Среда, 10.01.2018, 09:32 | Сообщение № 19
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
nilem, Karataev, огромное спасибо за предложенные варианты. оба варианта отлично справляются с задачей, жаль правда что в кодах нет комментариев и мне сложно определить, что конкретно выполняется в той или иной строке.
Хочу отметить код предложенный nilem, он даже перевыполнил задачу т.к. нет фильтра по ".jpg", а он просто удаляет файлы с расширением .tif и .png если есть дублер другого расширения, это даже очень! были два файла .bmp и .tif он справился и оставил только .bmp
Ещё раз спасибо!


Я не Гуру, но стремлюсь!
 
Ответить
Сообщениеnilem, Karataev, огромное спасибо за предложенные варианты. оба варианта отлично справляются с задачей, жаль правда что в кодах нет комментариев и мне сложно определить, что конкретно выполняется в той или иной строке.
Хочу отметить код предложенный nilem, он даже перевыполнил задачу т.к. нет фильтра по ".jpg", а он просто удаляет файлы с расширением .tif и .png если есть дублер другого расширения, это даже очень! были два файла .bmp и .tif он справился и оставил только .bmp
Ещё раз спасибо!

Автор - ZamoK
Дата добавления - 10.01.2018 в 09:32
Karataev Дата: Среда, 10.01.2018, 09:35 | Сообщение № 20
Группа: Проверенные
Ранг: Старожил
Сообщений: 1256
Репутация: 485 ±
Замечаний: 0% ±

Excel
Я инициативу не стал проявлять, сделал согласно первого поста.


Киви-кошелек: 9166309108
Яндекс-деньги: 410014131888288
 
Ответить
СообщениеЯ инициативу не стал проявлять, сделал согласно первого поста.

Автор - Karataev
Дата добавления - 10.01.2018 в 09:35
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление одинаковых файлов с разным расширением (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!