Страницы: 1
RSS
Копирование файла из сообщения Outlook в папку, открытую по гиперссылке
 
Добрый день!
На листе работает макрос, который по клику ПКМ в диапазоне G5:V500 открывает папку по гиперссылке из ячейки столбца Е той же строки, затем активирует окно Outlook, из которого я перетаскиваю файл руками в открытую папку.
Можно ли автоматизировать процесс, чтобы файл копировался в папку из сообщения сам (не важно - открыта папка, или нет)
Прошу прощения - файл выложить не могу, корпоративный интернет(
Код:
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("G5:V500")) Is Nothing Then  ' Открывает нужную папку  гиперссылкой
        ActiveCell.EntireRow.Cells(5).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
        Application.Wait Now + TimeSerial(0, 0, 2) 'Задержка срабатывания макроса
        Target = Date
        Outlook.ActiveExplorer.Activate 'Активирует Аутлук
        Application.EnableEvents = True
        Cancel = True
End If
End Sub
 
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("G5:V500")) Is Nothing Then  ' Открывает нужную папку  гиперссылкой
            ActiveCell.EntireRow.Cells(5).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
            Application.Wait Now + TimeSerial(0, 0, 2) 'Задержка срабатывания макроса
            Target = Date
            Dim Outlook As Object
            Set Outlook = GetObject(, "Outlook.Application")
            Outlook.ActiveExplorer.Activate 'Активирует Аутлук
            Dim oMail As Object
            Set oMail = Outlook.ActiveExplorer.Selection.Item(1)
            Dim oAtch As Object
            For Each oAtch In oMail.Attachments
                oAtch.SaveAsFile ActiveCell.EntireRow.Cells(5).Hyperlinks(1).Address & "\" & oAtch
            Next
            
            Application.EnableEvents = True
            Cancel = True
    End If
End Sub
Изменено: МатросНаЗебре - 27.09.2022 17:12:29
 
МатросНаЗебре, ругается (хотя  в конце этой строки oAtch = "название файла вложения в сообщении") и ничего не сохраняет. Вот на эту строку кода
Код
oAtch.SaveAsFile ActiveCell.EntireRow.Cells(5).Hyperlinks(1).Address & "\" & oAtch
Изменено: evg_glaz - 27.09.2022 17:22:42
 
Посмотрите что у Вас в
Код
ActiveCell.EntireRow.Cells(5).Hyperlinks(1).Address

вдруг там несуществующий путь. А вообще, когда пишете
Цитата
evg_glaz написал:
ругается
пишите текст и номер ошибки. Иначе помочь сложно - кто его знает на что там ругается(объект не найден, путь не верный, еще чего...).
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков,
Цитата
пишите текст и номер ошибки
Текст: Run-time error '-2147024893 (80070003)': Не удается сохранить вложение. Путь не существует. Проверьте, правильно ли он создан.

Но гиперссылка рабочая, папка открывается.
Строка
Код
oAtch.SaveAsFile ActiveCell.EntireRow.Cells(5).Hyperlinks(1).Address & "\" & oAtch
выделяется желтым. Коммент (при наведении мышки на желтый текст (извините, не знаю как называется)) в конце строки на & oAtch  выдает правильное имя вложения из почты "Имя файла.xlsx"
 
Цитата
evg_glaz написал:
Путь не существует.
это ни на какие мысли не наводит?
Цитата
evg_glaz написал:
oAtch  выдает правильное имя вложения
это супер, конечно, но что идет ДО этого? Я же выше даже уточнил:
Цитата
Дмитрий(The_Prist) Щербаков написал:
Посмотрите что у Вас в
ActiveCell.EntireRow.Cells(5).Hyperlinks(1).Address
Вы понимаете, что полный путь для сохранения состоит не только в имени файла, но и в имени папки, которая как раз берется из ActiveCell.EntireRow.Cells(5).Hyperlinks(1).Address? Вот что у Вас в этом Address?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков,
Цитата
Вот что у Вас в этом Address
больше ничего в строке  oAtch.SaveAsFile ActiveCell.EntireRow.Cells(5).Hyperlinks(1).Address & "\" , только имя файла в & oAtch  (при наведении мыши, если я правильно понимаю)
В ячейке 5го столбца - адрес папки (гиперссылка)
Изменено: evg_glaz - 28.09.2022 09:24:21
 
ну я уже и не знаю как донести мысль...Наведите мышь на Address и посмотрите что там. Если не получается - перед этой строкой запишите такую:
Код
Debug.Print ActiveCell.EntireRow.Cells(5).Hyperlinks(1).Address & "\" & oAtch

и посмотрите в окне Immediate что будет выведено. Должен быть полный путь к папке и имя файла. Если окно Immediate не видите - из редактора VBA нажмите сочетание клавиш Ctrl+G.
Изменено: Дмитрий(The_Prist) Щербаков - 28.09.2022 10:13:14
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков,
Цитата
из редактора VBA нажмите сочетание клавиш Ctrl+G.
Странно... в окне Immediate адрес не полностью, нет начала адреса (C:\Users\gl........v\Г.............В\), хотя в ячейке с гиперссылкой адрес папки полный)
 
Цитата
evg_glaz написал:
хотя в ячейке с гиперссылкой адрес папки полный
так значит надо брать не из гиперссылки, а из ячейки:
Код
oAtch.SaveAsFile ActiveCell.EntireRow.Cells(5).Value & "\" & oAtch
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков, всё гениальное просто!!!
Спасибо большое, работает!

А не поможете в таком вопросе - если файл с таким именем есть в папке, то уведомление выводится?
Страницы: 1
Наверх