Все технические форумы на одном сайте Удобный поиск информации с популярных форумов в одном месте
Вопрос: Сохранение вложений писем Outlook в другую папку Outlook ( не на жестком диске)

Доброй ночи!

Собственно приходят письма outlook в которые вложены письма outlook. Вложенные письма Пользователю необходимо просмотреть/проверить и отправить. Если открывать эти письма из самого письма то кнопка для отправки неактивна. Пользователь вынужден сохранить эти письма в другой папке outlook (например Черновики) и затем отправлять. Собственно нужен макрос который перемещал бы вложения текущего письма в папку Черновики.

На просторах нашел код, который сохраняет эти письма на локальном диске. Необходимо его как-то переделать, что бы осуществить задуманное.
Вариант сохранять на локальном диске и оттуда пользователю отправлять письма не предлагать.
Заранее спасибо!
 Sub SaveAtt()
    Dim oMail As MailItem
    Set oMail = Outlook.Application.ActiveExplorer.Selection(1)
 
    Dim att As Attachment
    For Each att In oMail.Attachments
                
        With att
            .SaveAsFile "c:\1\" & .FileName
           'ниже задокументирована строка коротая могла бы сработать, но не работает
           ' .Item.Move Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders("Черновики")
        End With
        
    Next
    Set oMail = Nothing
End Sub
Ответ: Похоже, что все равно необходимо выгружать в папку на диске. поэтому написал пока такой код.
Есть другие предложения?

Sub SaveAtt()
    Dim oMail As Outlook.MailItem, oMail_temp As Outlook.MailItem
    Dim strTempFilePath As String
    Dim att As Attachment
    Dim k As Integer, res As Integer

    On Error GoTo ErrHandler
    'выбираем текущее открытый элемент
    Set oMail = Outlook.Application.ActiveExplorer.Selection(1)
    'проверяем, что в сообщении имеются вложения
    If oMail.Attachments.Count = 0 Then MsgBox ("В данном письме отсутствуют вложения!"): Exit Sub
    'перебираем элементы вложений
    For Each att In oMail.Attachments
        'проверяем, что вложение формата msg
        k = InStrRev(att.FileName, ".")
        If (Mid(att.FileName, k + 1, Len(att.FileName) - k)) = "msg" Then
            'если это наш вариант то работаем с ним
            'запросим у пользователя нужно ли открывать письма после перемещения
            If res = 0 Then res = MsgBox("Показать вложенные письма?", 4, "Открытие вложений")
            'извлекаем его в папку Temp пользователя (C:\Users\user\AppData\Local\Temp)
            strTempFilePath = Environ("TEMP") & "\" & att.FileName
            'сохраняем файл
            att.SaveAsFile strTempFilePath
            'указываем этот элемент для работы с ним в качестве сообщения
            Set oMail_temp = Outlook.Application.CreateItemFromTemplate(strTempFilePath)
            'перемещаем его в папку Черновики почты Outlook
            oMail_temp.Move Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders("Черновики")
            If res = 6 Then oMail_temp.Display
            Set oMail_temp = Nothing
            'удаляем сообщения из папки Temp
            Kill strTempFilePath
        End If
    Next
    Set oMail = Nothing

  
Exit Sub
'обработчик ошибок
ErrHandler:
Select Case Err.Number
    Case 440
        MsgBox "Не выбрано почтовое сообщение!"
    Case Else
        MsgBox "Произошла ошибка " & Err.Number & vbNewLine & _
                Err.Description, vbInformation
End Select

End Sub
Вопрос: Импорт контактов Outlook

Задача заключается в том, что бы считать контакты Outlook, всё бы хорошо, есть куча статей с описанием, например

или очень в тему документация от монополиста,
однако она на VB и с делфи ну ни как не хочет стыковаться

полуопытным путём пришёл к коду
+

procedure SaveOutlookToTxt(FolderName:string);
  var
   //переменные для работы с Outlook
   OutlApp:	OutlookApplication;
   OutlNamespace: Namespace;
   ContactFolder: MAPIFolder;
   filter:Items;
   Contact: ContactItem;
   ContactList:	OleVariant;
   CLT:IDispatch;
   t2: DistListItem;
   test:OleVariant;
   myRecipients:	OleVariant;
   //переменные для работы с файлом
   TXTFile:textfile;
   //ContactListFile,ContactFile:textfile;
   //общие переменные
   i,j:integer;
   zz:	string;


       begin
             AssignFile(TXTFile, FolderName+'\ContactsAll.txt') ;
             Rewrite(TXTFile);
             OutlApp := CoOutlookApplication.Create;                                //
             OutlNamespace := OutlApp.GetNameSpace('MAPI');                        //
             ContactFolder := OutlNamespace.GetDefaultFolder(olFolderContacts);   //инициализация
             Contact := OutlApp.createitem(olContactItem) as ContactItem;
             filter:= ContactFolder.Items.Restrict('[MessageClass] ="IPM.DistList"');
             test:= OutlApp.CreateItem(olDistributionListItem);
             for i := 1 to filter.Count do begin //цикл по всем элементам Outlook
                 test:= filter.Item(i);
                 Writeln(TXTFile,'!'+test.DLName);
                 for j:=1 to test.MemberCount do begin     //    filter.Item(i)
                      zz:=test.GetMember(j).item(i).address;  //????
                     //Contact.
                     Writeln(TXTFile,zz);
                 end;
             end;
             CloseFile(TXTFile);
       end;


всё хорошо, но строчка "test.GetMember(j).item(i).address" вызывает ошибку, насколько понимаю тип выходящих данных IRecipient не смотря на то что в описании у него есть свойство address оно его не воспринимает прилагаю скриншот с ошибкой.

помогите пожалуйста, уже третий день мучаюсь с этой строчкой.

К сообщению приложен файл. Размер - 137Kb
Ответ: kv67,

спасибо ваш код сработал, однако сначала выдавал ошибку, проблема была в самом Outlook списки рассылок почему то были пустые но при этом Test.MemberCount возвращал старое число.
Вопрос: Отправка сообщения в Outlook из Excel

Здравствуйте.
Помогите пожалуйста с таким вопросом:
макросом из екселя в Outlook отправляю сообщение

Sub otpr_()
p_ = ThisWorkbook.Path & "\"
WBN_ = p_ & [Дано!i4]
Subj_ = [Дано!c36] ' тема
Addr_ = [Дано!c4] ' адрес
Text_ = [Дано!c37] ' текст
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)
With myItem
.Attachments.Add WBN_ ' вложение
.to = Addr_ ' адрес
.Subject = Subj_ ' тема
.Body = Text_ ' текст
.Send
End With
End Sub

на что Outlook пишет "Программа пытается отправить сообщение от Вашего имени .... Разрешить:Запретить". В принципе, один раз нажать на кнопку не влом, но предполагается все это засунуть в цикл и тогда будет штук 100 отправок.
Вопрос: как избежать этого сообшения?
Заранее благодарен.
Ответ: Rikozenit,

MS Outlook: Центр управления безопасностью\ Параметры центра...\ Программный доступ\ Никогда не предупреждать
или
просто установить какой-нибуть антивирус
Вопрос: MS Outlook 2003

Почему MS Outlook 2003 не может синхронизироваться с почтой mail.ru, при добавлении ящика начинается синхронизация и первая из ошибок это - не удаётся найти папку null (вкратце), потом начинается других целая куча ошибок. Пробовал на outlook 2016 эту же почту всё нормально работает. Что может быть не так с 2003?
Ответ:
Kiu
Что может быть не так с 2003?
Может быть не так то, что на одном ПК установлены сразу две версии Outlook. Он этого ой как не любит...Других вариантов пока нет.
Вопрос: outlook дергается список входящих писем

при подключении нескольких человек к одному ящику outlook дергается список входящих писем
в чем может быть дело?
Ответ:
Focha
bas02
при подключении нескольких человек к одному ящику outlook дергается список входящих писем
в чем может быть дело?

что значит "дергается список входящих писем"? у всех?


дергается у всех кто к ящику подключился
, если один юзер то не дергается

ps: пишу под другим именем так как то забанил злой Одмин
Вопрос: Outlook сортировка почты VBA

Казалось бы простейшая задача - папка "Входящие" в которую валится почта.
В папке - подпапка клиенты, в ней - еще подпапки с номерами клиентов типа: 102345, 102201 и тп.
Надо написать скрипт, который смотрит тему письма, и какой там номер встречается - в такую папку перемещаем сообщение из "входящих".
Перерыл кучу всего, почему то не выходит.
Не срабатывает на событие "Получение почты", точнее NewItem in Inbox.
Что-то я не так делаю.
И еще вопрос - я пытался віполнить пошагово кучу макросов, ставил точки для стопов - оно нигде не останавливалось.
Как вообще под этот Аутлук пишут то?

Мои попытки :
+
Private WithEvents olInboxItems As Items
Private WithEvents olSentItems As Items
Private WithEvents olDeletedItems As Items
Dim SavedPath As String
Private Const BUSINESS_FOLDER = "clients"
'   Bugfix #9
Dim objNameSpace As Outlook.NameSpace
Dim objStore As Outlook.Store

'   Some basic variables
Dim strFolderName As String
Dim strHits As String

'   Register our event hooks.
Private Sub Application_Startup()

    Dim NS As Outlook.NameSpace
    ' ALEX: add 08-12-16
    Set oInspectors = Application.Inspectors
    
    Set NS = Application.GetNamespace("MAPI")

    Set olInboxItems = Session.GetDefaultFolder(olFolderInbox).Items
    Set olSentItems = Session.GetDefaultFolder(olFolderSentMail).Items
    'Set olDeletedItems = NS.GetDefaultFolder(olFolderDeletedItems).Items
    
    Set NS = Nothing
End Sub


'   This section manages incoming emails.
Private Sub olInboxItems_ItemAdd(ByVal item As Object)

    '   If the item type is a mailitem (email)
    If TypeOf item Is MailItem Then
        '   Validate the email
        ValidateEmail item
    End If

End Sub

'   This section manages outgoing (sent) emails.
'       Note: This is only triggered when the email is placed in Sent Items.
' Emails in outbox, that have not yet been sent, will not be detected.
Private Sub olSentItems_ItemAdd(ByVal item As Object)

    If TypeOf item Is MailItem Then
        ValidateEmail item
    End If

End Sub

' ALEX: START block comment 08-12-16
'   This section manages deleted items.
'Private Sub olDeletedItems_ItemAdd(ByVal item As Object)

'    If TypeOf item Is MailItem Then
'        validateEmail item
'    End If

'End Sub
' ALEX: END


'   This function manages the criteria processing of our items.
'
Private Function ValidateEmail(ByVal item As Object)

    '   The error handler here will avoid the application hanging / terminating unexpectedly.
    On Error GoTo cannotValidate

    '   Prepare outside variables
    Dim olMailItem As MailItem
    
    '   Store the item (email passed to this function)
    Set olMailItem = item
    
    '   Check criteria
    If UCase(olMailItem.Subject) Like UCase("*CB??????*") = True Or UCase(olMailItem.Body) Like _
       UCase("*CB??????*") = True Then
        
        '   Prepare the rest of our variables, to save on memory footprint.
        Dim objOutlook As Outlook.Application
        '    Dim objNameSpace As Outlook.NameSpace
        Dim objSourceFolder As Outlook.MAPIFolder
        Dim objDestFolder As Outlook.MAPIFolder
        Dim strCriteria As String
        
        '   Store received criteria
        If UCase(olMailItem.Subject) Like UCase("*CB??????*") = True Then
            strCriteria = Mid(olMailItem.Subject, InStr(UCase(olMailItem.Subject), "CB"), 8)
        ElseIf UCase(olMailItem.Body) Like UCase("*CB??????*") = True Then
            strCriteria = Mid(olMailItem.Body, InStr(UCase(olMailItem.Body), "CB"), 8)
        End If
        
        '   Set the value of our scope variables.
        Set objOutlook = Application
        '   Buxfix #9 - Bind NameSpace relative to MailItem.
        Set objNameSpace = olMailItem.Session
        Set objStore = olMailItem.Parent.Store
        
        Set objSourceFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
        '   This is where the initial magic of this macro runs.
        '       Note: This macro searches all folders that begin with the criteria passed.
        Set objDestFolder = GetFolder(getDestinationFolder(strCriteria))
    
        '   Check that the final destination variable is now saved.
        '       WIP - Want to set this as a 'nothing' value, and compare against 'if not objDestFolder isnothing' then.
        '           Obviously; If this criteria is not met, the macro did not find a destination folder, and then will skip it.
        If Not objDestFolder Is Nothing Then
            olMailItem.Move objDestFolder
        End If
        
        '   Clear the variables defined in this scope.
        Set objOutlook = Nothing
        Set objNameSpace = Nothing
        Set objSourceFolder = Nothing
        Set objDestFolder = Nothing
    
    End If

    '   Clear our remaining variable
    Set olMailItem = Nothing

        
cannotValidate:
    ' Take no action - this prevents unhandled exceptions or the macro crashing.

End Function

'   This function searches for the destination folder that meets the criteria of getFolderName (passed) string.
Private Function getDestinationFolder(getFolderName As String)

    '   Error handling
    On Error GoTo failedGetDestinationFolder
    
    
    strFolderName = getFolderName
    
    '   Prepare our variables
    Dim olkStore As Outlook.Store
    Dim olkRoot As Outlook.folder
    Dim olkSearchFolder As Outlook.folder

    '   STR Hits is used to confirm if we have a hit on a folder search for each search - rather
    ' than being saved once for entire app.
    strHits = ""
    
    '   Check if saved path is stored.
    '       Note: That SavedPath is stored the first time any email is processed successfully
    '           (That is, criteria is met, folder is found, and email is stored).
    '           This was created to stop performance impacts when an email was processed in a
    '           mailbox that had hundreds of emails. Instead, now, a relative parent_
    '           path is stored, and subsiquent searches begin from this SavedPath location.
    '       Additionally: We can manage this feature moving forward, allowing it to search that location first, and
    '           then search the whole mailbox if not found.
    '           For the current feature request of DOBG - the 'clients' folder is the only folder we are to search.
    If SavedPath = "" Then
        '   Literally: For each mailbox (account)
        For Each olkStore In objNameSpace.Stores
            If strHits = "" Then
            '   Set this as our current outlook root variable
            Set olkRoot = olkStore.GetRootFolder
            '   For each folder within this root store's
            For Each olkSearchFolder In olkRoot.Folders
                '   Force the application to stop searching again, and again.
                If strHits = "" Then
                    '   If the folder name is CLIENTS
                    If UCase(olkSearchFolder.Name) = "CLIENTS" Then
                        '   Foreach sub folder of the clients folder.
                        For Each olkSearchFSubolder In olkSearchFolder.Folders
                            '   Added here to stop processing folders once the hit is found - given we are using a 'for each'
                            If strHits = "" Then
                                '   Process that folder
                                ProcessFolder olkSearchFolder
                            End If
                        Next
                        
                    End If
                
                End If
            Next
            
            End If
        Next
    '   Else: A saved path DOES exist. Lets begin our searches from that location instead.
    Else
        '   Set our outlook root as the SavedPath variable
        Set olkRoot = GetFolder(SavedPath)
        '   For each folder in that saved path
        For Each olkSearchFolder In olkRoot.Folders
            '   Process the folder.
            ProcessFolder olkSearchFolder
        Next
    End If

    
    '   If there are no hits by this stage, the criteria was met - but the destination folder was not found.
    If strHits = "" Then
        '   Return (string) NULL
        '       Note: I want to change this to setting the result to the vb value nothing.
        getDestinationFolder = "NULL"
    '   Else
    Else
        '   The folder WAS found, return the destination folder.
        getDestinationFolder = strHits
        Exit Function
    End If
    
    '   Unset the variables used in this function.
    Set olkRoot = Nothing
    Set olkStore = Nothing
    Set olkSearchFolder = Nothing
    
failedGetDestinationFolder:
        '   Avoids unexpected application hang / termination.
    Exit Function
End Function
 
 
'   Process the actual folder. This uses an environment (not scope) variable for comparison - avoiding us having to pass this variable each function. Perhaps not ideal?
Sub ProcessFolder(olkFld As Outlook.folder)

    '   Error handling
    On Error GoTo failedProcessingFolder
    
    '   If the folder matches our required criteria (The first 8 characters, in upper case, match the folder name we are looking for (also in upper case))
    'If UCase(olMailItem.Subject) Like UCase("*CB??????*") = True Then
    If UCase(olkFld.Name) Like UCase("*" & strFolderName & "*") = True Then
        '   Set our strHits to a hit.
        strHits = olkFld.FolderPath
        '   Save a relative (In this case, first level - parent) path.
        SavedPath = olkFld.Parent.FolderPath
    '   Else
    Else
        '   Prepare some space for each of the sub folders of this folder.
        Dim olkSub As Outlook.folder
        '   For each sub folder at this level.
        For Each olkSub In olkFld.Folders
            '   Process (sub function) that folder.
            ProcessSubFolder olkSub
        Next
        '   Clear our function variable
        Set olkSub = Nothing
    End If
    
failedProcessingFolder:
    '
    
End Sub

' =====================================
'   ALEX: MAY BE THIS PART IS PROBLEM
' =====================================
'   This function is the same as ProcessFolder, but contains relative code to save a relative path at a subfolder level.
Sub ProcessSubFolder(olkSubFld As Outlook.folder)

    On Error GoTo GetFolder_Error
    
    If UCase(olkSubFld.Name) Like UCase("*" & strFolderName & "*") = True Then
        strHits = olkSubFld.FolderPath
        '   Save the parent parent path (Which will likely be the folder 'clients'.
        SavedPath = olkSubFld.Parent.Parent.FolderPath
    Else
        Dim olkSubSub As Outlook.folder
        For Each olkSubSub In olkSubFld.Folders
            ProcessSubSubFolder olkSubSub
        Next
        
        Set olkSub = Nothing
    End If

GetFolder_Error:
'
End Sub

'   Same again as the above.
Sub ProcessSubSubFolder(olkSubSubFld As Outlook.folder)

    On Error GoTo GetFolder_Error
    
    If UCase(olkSubSubFld.Name) Like UCase("*" & strFolderName & "*") = True Then
        strHits = olkSubSubFld.FolderPath
        '   Save the parent parent parent folder, which again; will likely be the 'clients' folder.
        SavedPath = olkSubSubFld.Parent.Parent.Parent.FolderPath
    End If

    Set olkSubSub = Nothing
GetFolder_Error:
    '
    Exit Sub

End Sub

'   This function is used to return a vb outlook folder object of a string value relative path descriptor.
'       Basically turns '\\example@example.com\Inbox\TestFolder\TestFolder' string value as an Outlook.folder object
Function GetFolder(ByVal FolderPath As String) As Outlook.folder
    '   Prepare our function variables
    Dim TestFolder As Outlook.folder
    Dim FoldersArray As Variant
    Dim i As Integer
    
    ' Error handling
    On Error GoTo GetFolder_Error
    
    '   Parse our string and remove the root definition.
    If Left(FolderPath, 2) = "\\" Then
       FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set TestFolder = Application.Session.Folders.item(FoldersArray(0))
    
    '   Navigate the array to return the actual folder.
    If Not TestFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = TestFolder.Folders
            Set TestFolder = SubFolders.item(FoldersArray(i))
            If TestFolder Is Nothing Then
                Set GetFolder = Nothing
            End If
        Next
    End If
    'Return the TestFolder
    Set GetFolder = TestFolder
    Exit Function
    
GetFolder_Error:
    Set GetFolder = Nothing
    Exit Function
End Function
 
'   N/A
Sub TestGetFolder()
    Dim folder As Outlook.folder
    Set folder = GetFolder("\\Mailbox - Dan Wilson\Inbox\Customers")
    If Not (folder Is Nothing) Then
        folder.Display
    End If
End Sub


' Начало фрагмента A
Private Sub oInspectors_NewInspector(ByVal Inspector As Inspector)
 If Inspector.CurrentItem.Class = olMail Then
  If Len(Inspector.CurrentItem.EntryID) = 0 Then
   Set oMsg = Inspector.CurrentItem
  End If
 End If
End Sub

' Конец фрагмента A
Private Sub oMsg_Send(Cancel As Boolean)
Dim oRecipient As Recipient, oBusinessFolder As MAPIFolder, oEmailCopy As MailItem
 For Each oRecipient In oMsg.Recipients
  ' Начало фрагмента B
  If InStr(1, oRecipient.Address, "gmail.com") Then
' Конец фрагмента B
  oMsg.DeleteAfterSubmit = True
  Set oBusinessFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders(BUSINESS_FOLDER)
  Set oEmailCopy = oMsg.Copy
  oEmailCopy.Move oBusinessFolder
  Exit For
  End If
 Next
End Sub

Private Sub oMsg_Read(Cancel As Boolean)
Dim oRecipient As Recipient, oBusinessFolder As MAPIFolder, oEmailCopy As MailItem
 For Each oRecipient In oMsg.Recipients
  ' Начало фрагмента B
  If InStr(1, oRecipient.Address, "gmail.com") Then
' Конец фрагмента B
  oMsg.DeleteAfterSubmit = True
  Set oBusinessFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders(BUSINESS_FOLDER)
  Set oEmailCopy = oMsg.Copy
  oEmailCopy.Move oBusinessFolder
  Exit For
  End If
 Next
End Sub

Ответ: короче, как оказалось, в макросе ошибка была всего в одной строке
и этот ***(нехароший) Аутглюк не понимает ИМАП как InboxDefault.
Но дебажить в нем код - гемор еще тот. В следующий раз сто раз подумаю, прежде, чем браться за макросы в аутлуке.
Вопрос: Outlook. Шаблон для нового сообщения

Здравствуйте. Пишу про Outlook в тему для Exel, т.к. она ближе всего по духу в среде создания макросов.
У Outlook есть такая болячка как отсутствие вменяемой работы с шаблонами. Казалось бы какой пустяк сделать шаблон, чтобы при создании нового сообщения в тело письма вставлялось слово "Здравствуйте", а ниже вставлялась подпись. Но не тут-то было. Платный продукт Outlook вырос уже до великого и ужасного релиза 2013, а так и не научился у своих бесплатных конкурентов элементарным функциям.
Вариант - вставить слово "Здравствуйте" в саму подпись - не канает, т.к. в этом случае придется писать письмо в поле предназначенном для подписи, где нельзя полноценно редактировать.
Так же можно сохранить шаблон письма на компьютер и потом вызывать его специальным макросом каждый раз когда нужно написать письмо. Это пожалуй будет самый правильный и красивый вариант (особенно если повесить разноцветные кнопочки этих макросов на ленту), но он выгоден когда необходимо работать с большим количеством шаблонов. В случае, когда нужно вставить только лишь слово "Здравствуйте" в каждое новое письмо, нагромождать панель лишними кнопками и переобучать сотрудников нажимать не на кнопку "Создать сообщение" к которой они привыкли, а на "вон ту новую красивенькую кнопочку" как-то не комильфо. Пользователи, как известно, народ ушлый, но труднопереобучаемый. Да и переделывание ленты в Outlook для 100 пользователей не прельщает свой перспективой.
Порыскав ночку в интернетах нашел с виду неплохой макрос под свои нужды (вставлять макрос нужно в ThisOutlookSession предварительно разрешив выполнение макросов в параметрах безопасности Outlook).
Код:

Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector

Private Sub Application_Startup()
  Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
  Set m_Inspector = Inspector
End Sub

Private Sub m_Inspector_Activate()
  With m_Inspector.CurrentItem
    .HTMLBody = "Здравствуйте." & "<br>" & .HTMLBody
  End With
End Sub

И вроде срабатывает этот макрос как надо, даже при ответе и пересылке подставляется слово "Здравствуйте" и подпись, которая создана заранее обычными средствами Outlook. Но есть один неприятный момент который никак не могу победить - макрос срабатывает каждый раз когда идет обращение к редактируемому письму. Т.е. сколько раз закрыл-открыл черновик или просто кликнул правой кнопкой мыши в письме столько раз и вставляется слово "Здравствуйте".
И еще один момент - макрос работает только если редактируемое письмо открыто в новом окне, а не в теле основного окна Outlook. Но это не смертельно, просто нужно учитывать это при настройке Outlook для работы с этим макросом (настраивается в параметрах Outlook "Ответы и пересылка").

Так вот собственно сам вопрос - как научить данный макрос определять что в редактируемом письме в начале текста уже есть слово "Здравствуйте" и останавливаться если это слово найдено?
Заранее спасибо за любую помощь.

PS: Использую Outlook 2013 x64
Ответ:
Цитата:
Сообщение от ru3000
Outlook 2013 при ответе и пересылке по умолчанию использует синий цвет текста в теле письма. Чтобы учесть этот момент я немного доработал макрос. Теперь макрос будет проверять нет ли в письме слова "From:". Если нет, то в письмо будет вставлено слово "Здравствуйте" с автоматическим (черным) цветом. Если есть, то слово "Здравствуйте" будет окрашено в синий цвет (color:#205080).
Код:

Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector

Private Sub Application_Startup()
  Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
 Set m_Inspector = Inspector
End Sub

Private Sub m_Inspector_Activate()
  With m_Inspector.CurrentItem
    If InStr(.Body, "Здравствуйте") <> 1 Then
      If InStr(.Body, "From:") = 0 Then _
        .HTMLBody = "<span style=font-family:Calibri;font-size:11pt>Здравствуйте.</span><br>" & .HTMLBody
      If InStr(.Body, "From:") > 0 Then _
        .HTMLBody = "<span style=font-family:Calibri;font-size:11pt;color:#205080>Здравствуйте.</span><br>" & .HTMLBody
    End If
  End With
End Sub

Как уже говорил - Спасибо.

НО
обнаружилась ошибка при открытии вложенных писем или входящих писем - в них вставляется наше "Здрасте"...

Не уверен, что сделал правильно, но мои "костыли" вроде работают... )))) Надо еще тестировать...
Если у кого-то есть более корректный или элегантный вариант, дайте знать ))

Итак, у меня такой код получился:
Код:

Private Sub m_Inspector_Activate()
Dim value As Date
On Error Resume Next
value = m_Inspector.CurrentItem.CreationTime
If value <> "01.01.4501" Then Exit Sub            ' думаю, что эта проверка на Создание НОВОГО письма... 

txt_hi = "Коллеги, добрый день."
  With m_Inspector.CurrentItem
    If InStr(.Body, txt_hi) <> 1 Then
    On Error Resume Next
        .HTMLBody = "<span style=font-family:Arial;font-size:10pt;color:#205080>" & txt_hi & "</span>" & "<br>" & .HTMLBody
    End If
  End With
End Sub

Вопрос: Отправка письма через Outlook с определенного почтового ящика

Всем привет!

Создал форму для отправки письма через Outlook следующим образом:
C#
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 private void button1_Click(object sender, EventArgs e)
        {
            try
            {
                Outlook._Application _app = new Outlook.Application();
                Outlook.MailItem mail = (Outlook.MailItem)_app.CreateItem(Outlook.OlItemType.olMailItem);
                mail.To = textBox1.Text;
                mail.Subject = textBox2.Text;
                mail.Body = textBox3.Text;
                mail.Importance = Outlook.OlImportance.olImportanceNormal;
                ((Outlook.MailItem)mail).Send();
                MessageBox.Show("Ваше сообщение отправлено!");
            }
            catch (Exception ex)
            {
                MessageBox.Show(ex.Message, "Ошибка");
            }
        }
Вопрос в следующем: если у меня в аутлуке несколько почтовых ящиков, как сделать так, чтобы отправлялось письмо с определенного, который мне нужен?

Заранее спасибо.
Ответ: Не проверял, но должно быть так:
C#
1
2
3
4
5
6
7
8
9
10
11
12
13
14
public static void SendEmailFromAccount(Outlook.Application application, string subject, string body, string to, string smtpAddress)
{
            // Create a new MailItem and set the To, Subject, and Body properties.
            Outlook.MailItem newMail = (Outlook.MailItem)application.CreateItem(Outlook.OlItemType.olMailItem);
            newMail.To = to;
            newMail.Subject = subject;
            newMail.Body = body;
 
            // Retrieve the account that has the specific SMTP address.
            Outlook.Account account = GetAccountForEmailAddress(application, smtpAddress);
            // Use this account to send the e-mail.
            newMail.SendUsingAccount = account;
            newMail.Send();
}
взял
Вопрос: Перенос файла Outlook.pst с диска C:

Добрый день!

Скажите пожалуйста: можно ли средствами MS Outlook перенести файл Outlook.pst с диска C: например на диск D: (аналогично перенесению папки "мои документы") чтобы при очередной переустановке системы случайно не забыть его скопировать и не потерять все данные/контакты? Я не смог найти подобного функционала... И хватит ли сохранения файла Outlook.pst для сохранения контактов/заметок/задач и т.п.?

p.s. для MS Outlook 2007 я не смог найти файла Outlook.pst - подскажите пожалуйста - в чем Outlook 2007 хранит свои данные?
Ответ: Еще один вариант:
в ветке HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Outlook (15.0 соответствует версии Office; в данном случае - 2013, остальные версии, думаю, найти не проблема) создаем "Расширяемый строковый параметр" (Reg_Expand_SZ) с именем ForcePSTPath и в значении указываем нужный путь без кавычек. Таким же образом задается пусть для OST файлов (ForceOSTPath).
Плюс данного метода в том, что если это проделать перед первой настройкой почты, Outlook.pst сразу появится в указанной папке, и не нужно будет потом колдовать с переназначением папок.

В приложенном reg файле пример, который делает по умолчанию папку D:\Outlook для файлов PST в Outlook 2007 и 2013

К сообщению приложен файл (Изменение пути файлов Outlook.reg - 544bytes)
Вопрос: Delphi + Outlook

Здравствуйте. Подскажите пожалуйста как поставить адресата в копию или скрытую копию при отправке через Outlook

procedure TForm1.Button5Click(Sender: TObject);
const
    olMailItem = 0;
  var
    Outlook: OLEVariant;
    MailItem: Variant;
  begin
    try
      Outlook:= GetActiveOleObject('Outlook.Application');
    except
      Outlook:= CreateOleObject('Outlook.Application');
    end;
    MailItem:= Outlook.CreateItem(olMailItem);
 // MailItem.Recipients.Add('SPP2@vtb24.ru');
 MailItem.Recipients.Add(Edit1.Text);
 MailItem.Recipients.Add(Edit2.Text);
    MailItem.Subject:= Memo2.Text;
    MailItem.Body:= Memo1.Lines.Text;
// MailItem.Attachments.Add('C:\Windows\Win.ini');
    MailItem.Send;
    Outlook := Unassigned;
      Memo1.Lines.Clear;
       Memo2.Lines.Clear;
end;
Ответ:
_Vasilisk_
CreateItemFromTemplate не поможет?