Question

以下是我尝试创建的内容：

用户每周创建几次电子邮件，并且必须重新输入所有内容（要求更新员工），最多可容纳5个人。在VBA中创建起来非常容易，除了员工可以每次更改之外。因此，可能只有一个人，或者两个或三个，等等。。。每次都有不同的员工组合。他们需要输入框提示输入多少电子邮件，然后根据该输入，输入允许跟进的框（如果超过1个）（每个框1个）。然后，需要创建电子邮件，将输入框数据放入正文中。每个电子邮件文本将基于第一个输入框的输入，因此可以根据员工人数进行调整（因此，每封电子邮件中最多可以有5名员工）。

如何为变量（findstrs和foundcells）分配值，以便它们在不编写所有IF stmts的情况下适应输入框的输入？

Dim aOutlook As Object
  Dim aEmail As Object
  Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
  Dim strbox As String
  Dim stritem As String
  Dim X As Long
  Dim r As Long
  Dim LR, lookrng As Range
  Dim findStr As String
  Dim nameCol As Range
  Dim nameCol1 As Range
  Dim nameCol2 As Range
  Dim nameCol3 As Range
  Dim nameCol4 As Range
  Dim foundCell As Variant
  Dim foundCell1 As Variant
  Dim foundcell2 As Variant
  Dim strname  As String
  Dim strBody As String
  Dim sigString As String
  Dim signature As String
  Dim findstr1 As String
  Dim foundrng As Range
  Dim valuefound As Boolean
  Dim strFilename As String

   Select Case Application.ActiveWindow.Class
           Case olInspector
                Set oMail = ActiveInspector.CurrentItem
           Case olExplorer
                Set oMail = ActiveExplorer.Selection.Item(1)
    End Select                        

    If Dir(sigString) <> "" Then
        signature = GetBoiler(sigString)
    Else
        signature = ""
    End If

    Set oReply = oMail.ReplyAll

   Select Case Application.ActiveWindow.Class
    Case olInspector
        Set oMail = ActiveInspector.CurrentItem
    Case olExplorer
        Set oMail = ActiveExplorer.Selection.Item(1)
   End Select       


Set aOutlook = CreateObject("Outlook.Application")
Set oReply = aOutlook.CreateItem(0)

'Input box(es)

    findStr = InputBox("Enter Number of Employees")
    findstr1 = InputBox("Enter Name of First Employee")
    If findStr = "2" Then findstr2 = InputBox("Enter Name of Second Employee")
    If findstr1 = "T1" Then foundCell1 = "<B>Test 1 ID#0000</B>"
    If findstr1 = "T2" Then foundcell2 = "<B>Test 2 IDO#0001</B>"
    If findstr1 = "T3" Then foundcell3 = "<B>Test 3 ID#0002</B>"
    If findstr1 = "T4" Then foundCell4 = "<B>Test 4 ID#0003</B>"
    If findstr1 = "T5" Then foundCell5 = "<B>Test 5 ID#0004</B>"
    If findstr2 = "T1" Then foundCell1 = "<B>Test 1 ID#0000</B>"
    If findstr2 = "T2" Then foundcell2 = "<B>Test 2 IDO#0001</B>"
    If findstr2 = "T3" Then foundcell3 = "<B>Test 3 ID#0002</B>"
    If findstr2 = "T4" Then foundCell4 = "<B>Test 4 ID#0003</B>"
    If findstr2 = "T5" Then foundCell5 = "<B>Test 5 ID#0004</B>"



'Greeting based on time of day

    Select Case Time
           Case 0.25 To 0.5
                GreetTime = "Good morning"
           Case 0.5 To 0.71
                GreetTime = "Good afternoon"
           Case Else
                GreetTime = "Good evening"
    End Select           


sigString = Environ("appdata") & _
                "\Microsoft\Signatures\Update.htm"

        If Dir(sigString) <> "" Then
         signature = GetBoiler(sigString)
         Else
         signature = ""
        End If


    If findStr = "1" Then
        strBody = "<Font Face=calibri>Can you please update the following:  <br><br>" & _
        "<B>" & foundCell1 & "</B><br><br>" & _
        "Please update this batch.  " & _
        "I Appreciate your help. Let me know if you need anything.<br><br>" & _
        "Thanks <br><br>" & _        
        subject = "Employee Update"

    ElseIf findStr = "2" Then
        strBody = "<Font Face=calibri>Can you please add changes for the following: " & _
              "<ol><li><B>" & foundCell1 & "</B><br><br><br><br>" & _
              "<li><B>" & foundcell2 & "</B><br><br>" & _

        subject = "Multiple Employee Requests"
    End If


'Sets up the email itself and then displays for review before sending

With oReply
.HTMLBody = "<Font Face=calibri>Hi there,<br><br>" & strBody & signature
.To = "superman@krypton.com"
.CC = "trobbins@shawshank.com "
.subject = "Multiple Employee Updates"
.Importance = 2



.Display
End With

End Sub

Answer 1

您需要将此代码分为多个，较小的和参数化的范围。

使用Function的批号，创建一个Collection来返回电子邮件的正文。

 Private Function GetEmailBody(ByVal batchNumbers As Collection) As String

现在，调用代码需要知道有多少个员工。为此做一个功能。

Private Function GetNumberOfEmployees() As Long
    Dim rawInput As Variant
    rawInput = InputBox("Number of employees?")
    If StrPtr(rawInput) = 0 Then
        'user cancelled out of the prompt
        GetNumberOfEmployees = -1
        Exit Function
    Else If IsNumeric(rawInput) Then
        GetNumberOfEmployees = CLng(rawInput)
    End If
End Function

如果用户取消提示，则会返回-1，否则将返回0，否则将返回员工人数。

Dim employeeName As String
Dim nbEmployees As Long
nbEmployees = GetNumberOfEmployees
If nbEmployees = -1 Then
    Exit Sub 'bail out
Else If nbEmployees = 0 Then
    'reprompt?
    Exit Sub 'bail out, cancelled
End If

'fun part here

Dim emailbody As String
emailBody = GetEmailBody(batchNumbers, employeeName)

现在是有趣的部分：您需要向batchNumbers集合中添加与nbEmployees一样多的项目。因为您知道开始循环之前需要进行多少次迭代，所以For循环就可以了。

Dim batchNumbers As Collection
Set batchNumbers = New Collection

Dim batchNumber As String
Dim i As Long
For i = 1 To nbEmployees
    batchNumber = GetBatchNumber(i)
    If batchNumber = vbNullString Then Exit Sub 'bail out:cancelled/invalid
    batchNumbers.Add batchNumber
Next

Dim body As String
body = GetEmailBody(batchNumbers)

GetBatchNumber(i)是另一个函数调用，该函数的作用是提示输入雇员编号并查找并返回相应的批处理编号，如果取消了提示或找不到匹配项，则返回一个空字符串

Private Function GetBatchNumber(ByVal index As Long) As String
    Dim rawInput As Variant
    rawInput = InputBox("Name of employe " & index & ":")
    If StrPtr(rawInput) = 0 Then
        'cancelled
        Exit Function
    Else 
        Dim employeeName as String
        employeeName = CStr(rawInput)
        GetBatchNumber = GetBatchForEmployee(employeeName)
    End If
End Function

如果映射实际上看起来像T1 -> <B>Test 1 ID#000</B>，那么您可以使用此代码：

Private Function GetBatchForEmployee(ByVal employeeName As String)
    Dim digit As Long
    digit = CLng(Right$(employeeName, 1))
    GetBatchForEmployee = "<B>Test " & digit & " ID#" & Format$(digit - 1, "000") & "</B>"
End Function

如果您的映射是实际映射，则可以在此处进行Dictionary查找，或者在Excel工作表，CSV或XML数据文件，SQL Server数据库等上查找它们。

但是首先，分解。这样开始的过程：

  Dim aOutlook As Object
  Dim aEmail As Object
  Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
  Dim strbox As String
  Dim stritem As String
  Dim X As Long
  Dim r As Long
  Dim LR, lookrng As Range
  Dim findStr As String
  Dim nameCol As Range
  Dim nameCol1 As Range
  Dim nameCol2 As Range
  Dim nameCol3 As Range
  Dim nameCol4 As Range
  Dim foundCell As Variant
  Dim foundCell1 As Variant
  Dim foundcell2 As Variant
  Dim strname  As String
  Dim strBody As String
  Dim sigString As String
  Dim signature As String
  Dim findstr1 As String
  Dim foundrng As Range
  Dim valuefound As Boolean
  Dim strFilename As String

...这是个处理太多事情的过程。

多个输入框可创建不同的电子邮件

1 个答案: