Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Поиск письма в OutLook посредством VBA Excel, "ответить всем".
 
#1
05.07.2017 13:10:55
Друзья,
Задача:
1) открыть оутлук,
2) найти определенное письмо по теме (тему должен запросить всплывающим окошком),
3) нажать кнопку "Ответить всем".

заранее спасибо!
 
 
 
#2
05.07.2017 15:28:44
Задачу-то озвучили, а про сумму оплаты и срочность умолчали почему-то.
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#3
05.07.2017 15:36:57
за такую задачу могу только чаем угостить))
по мне так задача не сложная, для того, кто знает язык программирования.
думал, может есть спецы, которые подскажут.
 
 
 
#4
05.07.2017 15:39:44
Если не знаете, то и не можете оценивать сложность.
 
 
 
#5
05.07.2017 15:41:03
для меня, например, любая задача не сложная
но когда ставят ЗАДАЧУ, бесплатно никто не будет делать
бесплатно тут помогают с просьбами, и отвечают на вопросы
где ваши наработки? сами что-нибудь пробовали сделать?
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#6
06.07.2017 07:29:55
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Send_Mail_FIL()
 
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
  
    Application.ScreenUpdating = False
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Set objMail = objOutlookApp.CreateItem(0)
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
            
    sTo = "nnn@mmm.com"
    a = Format(Now + 1, "dd.mm.yyyy")
    sSubject = "Отгрузка" & a
    sBody = "<style type='text/css'>.def {font:11pt 'Calibri';color:#003366} .rb {font:bold;color:#003366}</style>"
    sBody = sBody & "<div class='def'>"
    sBody = sBody & "текст письма"
    sBody = sBody & "<br>"
    sBody = sBody & "Best regards,<br>"
    sBody = sBody & "<span class='rb'>Konstantin Korolev</span><br>"
     
    With objMail
        .To = sTo
        .CC = "nnn@mmm.com"
        .BCC = ""
        .Subject = sSubject
        .HTMLBody = sBody
        .Display
    End With
  
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True

ПРОСЬБА помочь, если кто знает.
весь интернет перелопатил, нет подобных статей.
 
 
 
#7
06.07.2017 08:26:34
Цитата
kkorole1 написал:
весь интернет перелопатил, нет подобных статей.
Как то плохо вы весь интернет лопатили, я нашел по первой же ссылке в Гугле
https://stackoverflow.com/questions/32083644/reply-all-in-outlook-from-excel-macro
Мы в Екселе не работаем, мы в нём живём!
 
 
 
#8
06.07.2017 11:28:15
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub test()
 
Dim mail 'object/mail item iterator
Dim replyall 'object which will represent the reply email
 
For Each mail In Outlook.Application.ActiveExplorer.Selection
    If mail.Class = olMail Then
        Set replyall = mail.replyall
        With replyall
            '.Body = "blah blah hello world"  '<-- uncomment and it will delete the thread
            .Display
        End With
    End If
Next
 
End Sub
Изменено: kkorole1 - 14.07.2017 14:46:44
 
 
 
#9
06.07.2017 11:29:08
panix1111,
подскажите, где прописать тему письма, чтоб нашел последнее письмо с этой темой?
может я что-то не понимаю...
Изменено: kkorole1 - 06.07.2017 11:37:22
 
 
 
#10
06.07.2017 11:32:56
1. На форуме с незнакомыми общаются на "Вы"
2. Оформление кода в сообщении - кнопка <...>
Прошу вернуться и исправить
 
 
 
#11
14.07.2017 14:48:32
помощи, видать уже не дождусь...
спасибо, что придирались к словам, хоть какой-то опыт останется...
 
 
 
#12
17.07.2017 12:44:10
Это не придирки а правила, которые позволяют комфортно существовать форуму.

по вашему вопросу:
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub Work_with_Outlook()
Dim SubjectOu As String
 
SubjectOu = InputBox("Введите тему", "Ввод")
 
Dim myOlApp As New Outlook.Application
Dim objNamespace As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Dim filteredItems As Outlook.Items
Dim itm As Object
Dim Found As Boolean
Dim strFilter As String
 
 
Set objNamespace = myOlApp.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
 
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & SubjectOu & "%'"
 
Set filteredItems = objFolder.Items.Restrict(strFilter)
 
If filteredItems.Count = 0 Then
    MsgBox "Нет такого"
    Found = False
Else
    Found = True
    ' this loop is optional, it displays the list of emails by subject.
    For Each itm In filteredItems
      Set ReplyAll = itm.ReplyAll
        With ReplyAll
            '.Body = "blah blah hello world"  '<--расскоментировать и вставить заготовку тескта-ответа
            .Display
        End With
      
    Next
End If
 
 
'If the subject isn't found:
If Not Found Then
    'NoResults.Show
Else
   Debug.Print "Found " & filteredItems.Count & " items."
 
End If
 
'myOlApp.Quit
Set myOlApp = Nothing
 
 
End Sub
Мы в Екселе не работаем, мы в нём живём!
 
 
 
#13
17.02.2020 14:22:52
.
Изменено: anism - 18.02.2020 16:05:53
 
 
 
Страницы: 1
Читают тему
Наверх
Loading...