需要帮助调整宏 [英] Need help tweaking a macro

问题描述

我在Outlook中有一个宏来处理对会议请求的响应，将它们放入电子邮件（格式化为表格）并将其发送给领导会议的内部协调人。它工作正常，但我想添加一些额外的功能，我的所有搜索都没有任何帮助。我使用Office365并在桌面上安装了Outlook 2016。我不是程序员！



以下是我的代码，我要改变的三件事：



1.我想根据人的反应方式更改每个表格单元格的背景颜色（strMeetStatus）



2.我想排除特定的内部电子邮件表格中填写的电子邮件地址列表中的地址



3，我想从接收电子邮件的人员的收件人字段中排除相同的特定内部电子邮件地址。



我尝试过：

I have a macro in Outlook that pulls the responses to a meeting request, puts them in an email (formatted as a table) and sends it to the internal facilitator leading the meeting. It's working, but I'd like to add some additional functionality and all my searches have resulted in nothing helpful. I use Office365 and I have Outlook 2016 installed on my desktop. I am not a programmer!

Below is my code, the three things I want to change:

1. I would like to change the background color of each table cell based on how the person responded (strMeetStatus)

2. I want to exclude a specific internal email address from the list of email addresses populated in the table

3, I want to exclude that same specific internal email address from the To field of people receiving the email.

What I have tried:

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

推荐答案

Quote：

需要帮助调整一个宏

你需要聘请一名专业的程序员。

自由职业者&在线查找自由职业者 - 自由职业者 [ ^ ]

这篇关于需要帮助调整宏的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！