Нужна помощь в настройке макроса
У меня есть макрос в Outlook, который извлекает ответы на запрос на собрание, помещает их в электронное письмо (отформатированное в виде таблицы) и отправляет его внутреннему фасилитатору, ведущему собрание. Это работает, но я хотел бы добавить некоторые дополнительные функции, и все мои поиски не привели ни к чему полезному. Я использую Office365, и на моем рабочем столе установлен Outlook 2016. Я не программист!
Ниже приведен мой код, три вещи, которые я хочу изменить:
1. я хотел бы изменить цвет фона каждой ячейки таблицы в зависимости от того, как человек ответил (strMeetStatus)
2. я хочу исключить конкретный внутренний адрес электронной почты из списка адресов электронной почты, заполненных в таблице
3, я хочу исключить тот же самый конкретный внутренний адрес электронной почты из поля кому людей, получающих электронное письмо.
Что я уже пробовал:
Sub GetResponsesToMeeting() Dim objApp As Outlook.Application Dim objItem As Object Dim objAttendees As Outlook.Recipients Dim objAttendeeReq As String Dim objAttendeeOpt As String Dim objOrganizer As String Dim dtStart As Date Dim dtEnd As Date Dim strSubject As String Dim strLocation As String Dim strNotes As String Dim strMeetStatus As String Dim strCopyData As String Dim strCopyResponses As String Dim strCount As String ' add to body Dim strAttendeesToEmail As String ' location field for email reminder Dim oAccount As Outlook.Account For Each oAccount In Application.Session.Accounts If oAccount = " " Then ' had to remove email address for this to post objMsg.SendUsingAccount = oAccount End If Next On Error Resume Next Set objApp = CreateObject("Outlook.Application") Set objItem = objApp.ActiveExplorer.Selection.Item(1) Set objAttendees = objItem.Recipients On Error GoTo EndClean ' Is it an appointment If objItem.Class <> 26 Then MsgBox "This code only works with meetings." GoTo EndClean End If ' Get the data dtStart = objItem.Start dtEnd = objItem.End strSubject = objItem.Subject strLocation = objItem.Location strNotes = objItem.Body objOrganizer = objItem.Organizer objAttendeeReq = "" objAttendeeOpt = "" ' Get The Attendee List For x = 1 To objAttendees.Count strMeetStatus = "" Select Case objAttendees(x).MeetingResponseStatus Case 0 strMeetStatus = "No Response" ino = ino + 1 Case 1 strMeetStatus = "Organizer" ior = ior + 1 Case 2 strMeetStatus = "Tentative" it = it + 1 Case 3 strMeetStatus = "Accepted" ia = ia + 1 Case 4 strMeetStatus = "Declined" ide = ide + 1 End Select If objAttendees(x).Type = olRequired Then objAttendeeReq = objAttendeeReq & "" & objAttendees(x).Name & "" & "" & strMeetStatus & "" & vbCrLf Else objAttendeeOpt = objAttendeeOpt & "" & objAttendees(x).Name & "" & "" & strMeetStatus & "" & vbCrLf End If strAttendeeAddress = objAttendees(x).Address If InStr(1, strAttendeeAddress, "/cn") & gt; 0 Then strCopyto = objAttendees(x).Name Debug.Print strAttendeeAddress, objAttendees(x).Name, objAttendees(x).Address strAttendeesToEmail = strAttendeeAddress & ";" & strAttendeesToEmail End If Next strCopyData = "Subject: " & strSubject & "<p>" & _ "Start: " & dtStart & "</p><p>" & "End: " & dtEnd & _ vbCrLf & vbCrLf strCopyResponses = "Required: " & "</p>" & objAttendeeReq & "<table></table>" & vbCrLf & "Optional: " & _ vbCrLf & "" & objAttendeeOpt & "<table></table>" strCount = "<p>Accepted: " & ia & vbCrLf & _ "<br>Declined: " & ide & vbCrLf & _ "<br>Tentative: " & it & vbCrLf & _ "<br>No response: " & ino & "<br></p>" Set ListAttendees = Application.CreateItem(olMailItem) ListAttendees.HTMLBody = strCopyData & "<p>" & strCopyResponses & "</p>" & "<p>" & strCount & "</p>" ListAttendees.Display With ListAttendees .Subject = "Responses for: " & strSubject .To = strAttendeesToEmail End With EndClean: Set objApp = Nothing Set objItem = Nothing Set objAttendees = Nothing End Sub
NotPolitcallyCorrect
"Я не программист", значит ли это, что вы хотите, чтобы мы делали для вас работу бесплатно?