Member 13031367 Ответов: 1

Нужна помощь в настройке макроса


У меня есть макрос в 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

"Я не программист", значит ли это, что вы хотите, чтобы мы делали для вас работу бесплатно?

1 Ответов

Рейтинг:
2

Patrice T

Цитата:
Нужна помощь в настройке макроса

Вам нужно нанять профессионального программиста.
Нанимайте фрилансеров и находите работу фрилансера онлайн-Freelancer[^]