Question

我从未使用过Outlook VBA（2010），但我的经理要求我创建一个发送IT请求和IS请求的用户表单。我创建了自定义表单，我收集了所有文本字段并将文本打印到单个文本框中。

此操作全部在Sub CommandButton1_Click()中定义，以Send()结尾。在sub中，我对所有文本框都有这样的内容：

 Set Sj =Item.GetInspector.ModifiedFormPages("P.2").Controls("Subject_Text")
 Set YNbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("YNBox")
 Set Rbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("ReasonBox")

我想知道的是如何在＆＃34; P.2＆＃34;并将其粘贴到＆＃34; Message＆＃34;的消息区域中。页？

以下是打印到单个文本框的代码段：

FinalBox.Text = "Subject: " & Sj.Text & vbCrLf & _
vbCrLf & "Can work around the issue?: " & YNbox.Text & _
vbCrLf & "Reason For Ticketing: " & Rbox.Text & _
vbCrLf & "Department: " & Dbox.Text & _
vbCrLf & "Impact: " & Ibox.Text & _
vbCrLf & "Urgency: " & Ubox.Text & _
vbCrLf & "System/Machine Number: " & Mbox.Text & _
vbCrLf & "Was trying to accomplish: " & Abox.Text & _
vbCrLf & "Has it occured before?: " & Bbox.Text & _
vbCrLf & "First Noticed: " & Tbox.Text & _
vbCrLf & "Others affected by the issue: " & Affbox.Text & _
vbCrLf & "Additonal Comments: " & Addbox.Text

那么，我该怎么做并将它附加到消息页面中的实际消息字段？

非常感谢!!

P.S。我在MailItem.body和每当我创建对象时遇到问题，例如：

Dim objMsg As Object，

我收到一条错误，上面写着＆＃34;预期声明结束＆＃34; ...我理解VB和VBA不同，但我并不认为它给了我这么多头疼

编辑：

Hello dbMitch和Tony Dallimore，谢谢你帮我澄清了我的问题。就像我提到的那样，当谈到VBA时，我只是初学者，而我只想

`Sub Commandbutton
 Set Sj = Item.GetInspector.ModifiedFormPages("P.2").Controls("Subject_Text")
 Set YNbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("YNBox")
 Set Rbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("ReasonBox")
 Set Dbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("DepartmentDropbox")
 Set Mbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("MachineBox")
 Set Ibox = Item.GetInspector.ModifiedFormPages("P.2").Controls("ImpactBox")
 Set Ubox = Item.GetInspector.ModifiedFormPages("P.2").Controls("UrgencyBox")
 Set Abox = Item.GetInspector.ModifiedFormPages("P.2").Controls("AccomplishBox")
 Set Bbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("BeforeText")
 Set Tbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("Timebox")
 Set Affbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("AffectedBox")
 Set Addbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("AdditionalBox")
 Set Tbox8 = Item.GetInspector.ModifiedFormPages("P.2").Controls("TextBox8")
 Set MESBOX = Item.GetInspector.ModifiedFormPages("Message").Controls("Message")

 Tbox8.Text = "Subject: " & Sj.Text & vbCrLf & _
    vbCrLf & "Can work around the issue?: " & YNbox.Text & _
    vbCrLf & "Reason For Ticketing: " & Rbox.Text & _
    vbCrLf & "Department: " & Dbox.Text & _
    vbCrLf & "Impact: " & Ibox.Text & _
    vbCrLf & "Urgency: " & Ubox.Text & _
    vbCrLf & "System/Machine Number: " & Mbox.Text & _
    vbCrLf & "Was trying to accomplish: " & Abox.Text & _
    vbCrLf & "Has it occured before?: " & Bbox.Text & _
    vbCrLf & "First Noticed: " & Tbox.Text & _
    vbCrLf & "Others affected by the issue: " & Affbox.Text & _
    vbCrLf & "Additonal Comments: " & Addbox.Text
 Send
End Sub
`

Sub我在网上发现了一个项目并将文本附加到邮件正文中。每次我尝试声明对象的类型（例如____ As _____）时似乎都会出错。我不确定如何修改它以使其适合我的代码，但错误是在Dim objItem As Object抛出

预期声明结束

Sub TestAppendText()
Dim objItem As Object
Dim thisMail As Outlook.MailItem
'On Error Resume Next

Set objItem = Application.ActiveExplorer.Selection(1)
If Not objItem Is Nothing Then
    If objItem.Class = olMail Then
        Set thisMail = objItem
        Call AppendTextToMessage(thisMail, "Some text added at " & Now())
    End If
End If

Set objItem = Nothing
Set thisMail = Nothing
End Sub

Sub AppendTextToMessage(ByVal objMail As Outlook.MailItem, ByVal strText As String)
    Dim objCDO As MAPI.Session
    Dim objMsg As MAPI.Message
    Dim objField As MAPI.Field

    Set objCDO = CreateObject("MAPI.Session")
    objCDO.Logon "", "", False, False

    If Not objMail.EntryID = "" Then
        Set objMsg = objCDO.GetMessage(objMail.EntryID, _
                                   objMail.Parent.StoreID)
        objMsg.Text = objMsg.Text & vbCrLf & strText
        objMsg.Update True, True
        Set objField = objMsg.Fields(CdoPR_RTF_COMPRESSED)
        If Not objField Is Nothing Then
            objField.Delete
            objMsg.Update True, True
        End If
        Set objField = Nothing
        Set objField = objMsg.Fields(CdoPR_RTF_SYNC_BODY_COUNT)
        If Not objField Is Nothing Then
            objField.Delete
            objMsg.Update True, True
        End If
     Else
        strMsg = "You must save the item before you add text. " & _
                 "Do you want to save the item now?"
        intAns = MsgBox(strMsg, vbYesNo + vbDefaultButton1, "Append Text to Message")
        If intAns = vbYes Then
            Call AppendTextToMessage(objMail, strText)
        Else
            Exit Sub
        End If
    End If

    Set objMsg = Nothing
    objCDO.Logoff
    Set objCDO = Nothing
End Sub

我也尝试过使用CDO对象，但它给出了一个错误

ActiveX组件无法创建对象：＆＃39; CDONTS.NewMail＆＃39;

Set Item1 = Item.MessageClass
Set objCDONTS = CreateObject ("CDONTS.NewMail")
objCDONTS.Body = Tbox8.Text

Item1.Message = "Hi"

如果对其他人来说这看起来很简单，我很抱歉。我只有0次VBA / VBScript和Outlook设计经验。这就是我在这里学习的原因！

Answer 1

请不要再问这样的问题了。我确实理解告诉一位经理你缺乏解决任务的背景的困难。典型的反应似乎是：“这很容易：只需在互联网上查找。”从某种意义上说，这是真的。在下面的答案中没有任何内容，你在其他答案中找不到。您缺少的是确定所需功能并将它们组合在一起以创建解决方案的背景。 VBA并不是一门困难的语言，但它与其他语言存在许多显着差异，这会使经验丰富的VBA程序员感到困惑。 Outlook对象模型需要时间来掌握。

有许多在线Excel VBA和Outlook VBA教程。我认为Excel VBA教程更好。如果要求您再次执行类似任务，则必须坚持有时间先学习。我的这些答案可能有所帮助：

我想创建一个完整的解决方案，因为我不相信其他代码片段会有所帮助。你需要：“这有效。根据您的具体要求逐步调整它。“

我不熟悉自定义表单，并且没有任何内容可以说明它们提供的优势超过了与所有版本的VBA一起使用的用户表单。我不想花时间研究自定义表单，特别是因为我有用户表单的代码，我可以轻松地根据您的要求进行调整。如果您的自定义表单令您满意，请替换我解决方案的那一部分。

我的解决方案有五个部分：

用户表单。
子例程SendTicket()的第一部分，用于加载用户表单并调用它以从用户处获取数据。
用户表单代码中的子例程UserForm_Initialize()，它根据SendTicket()提供的参数构建表单。
子例程CommandButton1_Click()，它对用户的数据执行最少的验证并将其存储为SendTicket()。
子例程SendTicket()的第二部分，它根据用户的数据构建电子邮件并将其发送给IT部门。

<强> 1。用户表单

我插入了一个新的用户表单，调整了它的大小并添加了控件。如果您不知道如何执行此操作，请查看介绍用户表单的其中一个教程。

如果我将标签控件添加到用户表单并将其命名为X，我可以，例如：

通过更改X.Top。
通过更改X.Caption。

用户表单包含名为Collection的{{1}}。集合是大多数语言称为未排序列表的集合。在Controls内，表单上的每个控件（标签，文本框，命令按钮等）都会有一个条目。如果标签X是用户表单上的第一个控件，我可以将其属性设置为Controls和Controls(0).Top。这意味着我可以使用特定于标签X的代码，通过名称引用它，或者我可以使用通用代码按照Controls(0).Caption中的位置处理所有或选定的标签。根据您的要求，我认为通用代码会更容易，这就是我所提供的。

我创建了一个标签控件和一个文本框控件。我保留了默认名称，但更改了一些属性：

Controls

以“*”开头的属性很重要。其他的是因为我喜欢它们影响表格外观的方式。

在英国，“Label1”和“TextBox1”是第一个标签和文本框的默认名称。使用Excel，默认名称因本地语言而异;我不知道Outlook是否属实。在代码中，它会告诉您如何在必要时更改默认名称。

我的代码假定标签的标题适合单行，但输入文本框的文本可能需要多行。

创建了我的标准标签和文本框后，我选择了它们，复制它们，粘贴它们然后移动副本，使它们完全位于第一对之下。我用四个控件重复了这个，然后是八个控件，最后是十六个控件。我以一列十六个标签和一列十六个文本框结束。我并不关心控件的垂直位置;我稍后处理。如果任一列未完全对齐，则可以选择一列并为整个组设置Left属性。我已经创建了具有数百个具有可接受性能的控件的表单，因此如果您愿意，可以添加更多。

我创建了一个命令按钮。我用文本框排成一行，但字体变大了。我保留了默认名称和标题。

通过最后创建命令按钮，控件按正确的Tab键顺序排列。打开表单，光标位于第一个（顶部）字段中，每个选项卡将光标移动到下一个字段，然后移动到按钮。

最后，我设置了表单的宽度，使其比控件宽一点。我设置了高度，使其接近我的笔记本电脑上的屏幕高度约560.可以从系统获得屏幕高度，但这超出了这个答案的范围。我将标题设置为“报告问题”。我把它命名为P2，我最接近你的名字（P.2是用户表单的无效名称）。结果是：

** 2.子程序SendTicket（）的第1部分**

宏无法直接将参数发送到用户表单或接收值。它必须使用全局变量。 LABEL TEXT BOX * Name Label1 TextBox1 Caption Prompt/Name Font Tahoma 10 Tahoma 10 Height 12 18 Left 12 230 * Multiline True * Scrollbars 2 - frmScrollBarsVertical TextAlign 3 – frmTextAlighRight 1 – frmTextAlignLegt Text/Value abcdefghijklmnopqrstuvwyz * Visible False False Width 200 400 * Word wrap True True是我用来将数据传递到用户表单的全局，我使用P2Params来传回数据。

P2Values是使用参数加载P2Params = Array("Subject", …)的语句。前三个参数是P2Params，它指定第一个文本框。提示/名称为“主题”，高度为18并且是必需的。每组另外三个参数定义另一个文本框。

我可以在表单中定义所有这些信息，但是如果你改变主意关于文本框的高度，那么得到这样的表格看起来你想要的方式会非常挑剔，所以必须移动所有较低的文本框下。使用此方法，您可以更改文本框的高度或更改序列或添加新字段，而不会有任何麻烦。注意：height定义分配给控件的高度。在我的笔记本电脑和我选择的字体上，54就足以支持四行。如果用户键入第五行，则滚动条将显示在相关控件上，以便用户可以看到所有行。您可以根据某些平均或典型的票证指定每个文本框的高度，但是如果用户想要输入的文本超出预期，则无关紧要。

"Subject", 18, True将表单加载到内存中并调用Load P2初始化表单。 UserForm_Initialize()将控件传递给表单。在用户执行返回控制的操作之前，不会返回控件。在这种情况下，单击命令按钮将返回控件，提供输入的值将传递验证代码。

第3。子例程UserForm_Initialize（）

我不打算对这个子程序说太多。代码中的注释完整地解释了代码的作用，下面的图像显示了结果：

如果您查看.Show vbModal中的参数。您可以看到此布局的来源。这种方法的优点在于，使用不同的参数集，可以生成非常不同的形式。导入文本值列表的要求并不少见，所以我之前和之后都会使用此代码的变体。

<强> 4。子例程CommandButton1_Click（）

用户可以在所需的文本框中输入值。一旦它们正确，用户点击命令按钮，该按钮在子例程P2Params的第一部分被重新标题为“发送”。

此例程验证所有必填字段都有值。我已经实现了允许范围和其他验证，但这足以满足您的要求。如果字段值可以接受，则例程会将输入的值加载到数组SendTicket()中。正如我所说，只有通过在全局变量中存储值，用户才能将值返回给调用者。

<强> 5。子例程SendTicket（）

此代码从P2Values获取值构建电子邮件并发送它。我已将电子邮件发送到实验性Gmail帐户。您需要将收件人替换为IT部门的地址。

<强>摘要

这里有很多想法。如果有必要，可以更慢地完成它，然后回答问题

<强> SendTicket（）

P2Values

用户表单代码

Option Explicit

  Public Type FieldDtl
    CtrlLabel As Long
    CtrlTextBox As Long
    Height As Long
    Mandatory As Boolean
    Prompt As String
  End Type

Public P2Params As Variant
Public P2Values() As String
Sub SendTicket()

  Dim InxFld As Long
  Dim InxPrm As Long
  Dim MailItemCrnt As MailItem

  P2Params = Array("Subject", 18, True, _
                   "Can you work around the issue?", 18, True, _
                   "Reason For Ticketing", 30, True, _
                   "Department", 18, False, _
                   "Impact", 18, True, _
                   "Urgency", 18, True, _
                   "System/Machine Number", 18, True, _
                   "Was trying to accomplish", 54, True, _
                   "Has it occured before?", 18, True, _
                   "First Noticed", 18, False, _
                   "Others affected by the issue", 42, True, _
                   "Additional Comments", 54, True)

  ' Used to test total height of control exceeding height of screen
  'P2Params = Array("Subject", 50, True, _
  '                 "Can you work around the issue?", 50, True, _
  '                 "Reason For Ticketing", 50, True, _
  '                 "Department", 50, False, _
  '                 "Impact", 50, True, _
  '                 "Urgency", 50, True, _
  '                 "System/Machine Number", 50, True, _
  '                 "Was trying to accomplish", 54, True, _
  '                 "Has it occured before?", 50, True, _
  '                 "First Noticed", 50, False, _
  '                 "Others affected by the issue", 54, True, _
  '                 "Additional Comments", 54, True)

  Load P2
  With P2
    .CommandButton1.Caption = "Send"
    .Show vbModal
  End With

 ' The bounds of P2Values are 1 to number of fields
 ' The bounds of P2Params could be 1 to NumberOfFields*3 but is almost
 ' certainly 0 to NumberOfFields*3-1

 Set MailItemCrnt = CreateItem(olMailItem)
 With MailItemCrnt
   .BodyFormat = olFormatPlain
   .Recipients.Add "AbbeyRuins33@gmail.com"
   .Subject = P2Values(1)           ' Assumes subject is first field
   .Body = P2Params(LBound(P2Params) + 3) & ": " & P2Values(2)
   InxFld = 3
   For InxPrm = LBound(P2Params) + 6 To UBound(P2Params) Step 3
     .Body = .Body & vbCrLf & P2Params(InxPrm) & ": " & P2Values(InxFld)
     InxFld = InxFld + 1
   Next
   .Display
   ' .Send
 End With
 Set MailItemCrnt = Nothing

End Sub

Outlook VBA脚本将文本从自定义窗体移动到邮件正文

1 个答案: