我目前对如何实现在VBA中获取和存储信息的过程感到困惑。
目标：
当前，我有一个函数可以获取座席名称（isagent（sAgent））并对其进行验证，获得票证编号（Incident（））并对其进行验证，并具有使用要格式化的字符串回复消息的功能消息（sBody）。
问题：
我要存放一个用于输入数据的存储容器。我不认为阵列是正确的选择，因为代理商的数量和每个代理商的票数每天都在波动。
例如： 昨天的请求：将票123重新分配给人1
今天的请求-将票123、456和789重新分配给人1。将012重新分配给人2，将345、678、901、234和567重新分配给人3。
格式：
存储数据的格式需要这样返回：
示例- 昨天的请求：123已重新分配给person1。 今天的要求： 123、456和789已重新分配给人员1。 012已重新分配给人员2。 345、678、901、234和567已重新分配给第3个人
代码：
此部分用于消息正文格式，可以将其组合为一个字符串（sBody）。当前，这些变量被设置为用于票证编号的sIncs，用于代理的sXferAgent以及用于句子时态的sTense。
'Set Body Reply
Dim sOpen, sBody, sAddendum, sClose As String 'Message Reply Format
sOpen = "<span style=""font-size:11.0pt;font-family:"Calibri",sans-serif;mso-bidi-font-family:" & vbCrLf & _
"Arial"">Team, <o:p></o:p></span>" & vbCrLf
sBody = "<p><span style=""font-size:11.0pt;font-family:"Calibri",sans-serif;mso-bidi-font-family:" & vbCrLf & _
"Arial"">" & sINCs & " " & sTense & " been created and assigned to " & sXferAgent & "<o:p></o:p></span></p>" & vbCrLf
sClose = "<p><span style=""font-size:11.0pt;font-family:"Calibri",sans-serif;mso-bidi-font-family:" & vbCrLf & _
"Arial"">Thanks & Regards,<o:p></o:p></span></p>" & vbCrLf & _
"<p><br/></p>"
olMsgReplyAll.HTMLBody = sOpen & sBody & sClose & sSig & olMsgReplyAll.HTMLBody
要获取故障单和代理商格式，以下是我的称呼方式：
Dim sInc As String
'Receive Incident Number as AlphaNumeric
sInc = Incident()
If sInc = "" Then
Exit Sub
End If
'Receive Agent Name
sAgent = ValidateAgent
If sAgent = "" Then
Exit Sub
End If
目前，我的半智半衰想法如下：
Sub Handoff()
'Get reassigned tickets in loop
'Asks for how many agents, ticket count per agent, gathers agent name and tickets for agent
'Functions in place for get agent name, and ticket number preformatted
'storage container issues for above process
'Formats data into separate lines with verbiage
Dim colReassignments As New Collection 'container for all reassignments
Dim colAgents As New Collection 'container for agents
Dim colTickets As New Collection 'container for tickets
Dim ReassignCount As Integer '# of tickets for the agent
Dim ReassignAgent As Integer 'Agents to reassign to
Dim Reassignments() As String
'Start inquiry
ReassignAgent = InputBox("Input number of Agents tickets being reassigned to:", "Agent Counter")
If ReassignAgent = vbNullString Then
Exit Sub
End If
While ReassignAgent > 0
colAgents.Add = ValidateAgent
ReassignCount = InputBox("Input number of ticket being reassigned to agent:", "Ticket Counter")
If ReassignCount = vbNullString Then
Exit Sub
End If
For Each agent In colAgents
For Each ticket In colTickets
agent(x).ticket(y) = Incident()
If agent(x).ticket(y) = "" Then
Exit Sub
End If
agent(x) = ValidateAgent
If agent(x) = "" Then
Exit Sub
End If
ReassignCount = ReassignCount - 1
Next ticket
Next agent
Wend
'Sentence Formatting
'Get Tense of reassignment
If ReassignCount > 1 Then
tense = "have"
Else
tense = "has"
End If
'Compile stored info
'Format: "(Ticket#(s)) (tense) been reassigned to (Agent)" repeat lines as necessary
'Process email
'In another module
End Sub
任何建议或建议，我们将不胜感激。我可能使问题复杂化了。
已更新以反映其他模块：
'Function to get ticket number
Public Function Incident()
Dim strPattern As String: strPattern = "^(?:INC|NC|C)?([0-9]{1,8}$)"
Dim strReplaceINC As String: strReplaceINC = "$1"
Dim regEx As New RegExp
Dim strInput As String
Dim IncResult As Boolean
Do
If strPattern <> "" Then
strInput = InputBox("Input Incident Number", "Ticket Number")
If strInput = vbNullString Then
Exit Function
End If
IncResult = False
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = strPattern
End With
If regEx.Test(strInput) Then
sInc = regEx.Replace(strInput, strReplaceINC)
sInc = "INC" & Format(sInc, "00000000")
IncResult = True
Else
MsgBox ("Please input a valid ticket number format")
IncResult = False
End If
End If
Loop While IncResult = False
Incident = sInc
End Function
'Function to select Agent
Public Function IsAgent(stxt As String) As Boolean
Dim aAgent As Variant, oItem As Variant, bans As Boolean
aAgent = Array("Bob", "Chuck", "David", "Fred", "John", "Kirk", "Paul", "Sean")
bans = False
For Each oItem In aAgent
If LCase(oItem) = LCase(Trim(stxt)) Then
bans = True
Exit For
End If
Next
IsAgent = bans
End Function
'Function to Validate Agent
Public Function ValidateAgent()
'Dim sAgent As String 'Assigned Agent
Do
sAgent = InputBox("Please enter a the assigned agent's name:", "Pick an Assignee's Name")
If sAgent = vbNullString Then
Exit Function
End If
If sAgent <> "" Then
If GlobalVars.IsAgent(sAgent) = True Then
sAgent = sAgent
Else
MsgBox ("Incorrect Name, pick a new one!")
End If
End If
Loop While GlobalVars.IsAgent(sAgent) = False
ValidateAgent = sAgent
End Function
答案 0 :(得分：0)
请不要在评论中张贴太多代码，因为它很难（不可能？）阅读。它应该添加到问题中。
我忘记了像ValidateAgent这样的例程的粗鲁名称。该名称隐藏了例程的作用，即输入经过验证的代理。像GetValidatedAgent之类的名字会更好
InputBox是一种输入多个值的笨拙方法。如果我理解正确，则用户输入代理，然后进行计数，然后对票证进行计数。周围有一个循环，该循环允许输入多个具有各自票证的代理。
假设我输入3张票，然后意识到有4张票？我该如何解决错误？假设我已经以鲍勃的身份进入鲍勃，并且在意识到我正在进入爱丽丝的门票之前就开始输入门票。我该如何解决我的错误？
我会使用表格。
如果每个代理商的代理商和票证的最大数量很少，我可能会选择一排文本框。例如，用户将在第1列中输入一个代理，在第2至5列中输入票。我可能会有10行。当用户移至新文本框时，我将验证代理和票证。在用户单击“提交”按钮之前，我不会检查一致性（例如，没有代理的情况下没有票据，没有代理的情况下没有代理商）。在数据一致或用户单击取消按钮之前，我不允许退出。使用这种布局，用户可以在屏幕上看到他们的全部输入，并且可以纠正任何有故障的代理商或故障单。
在退出表单之前，必须将数据保存在全局变量中。我可能会选择最简单的字符串数组：
AgentA,Ticket1,Ticket2,Ticket3
AgentB,Ticket4
AgentB,Ticket5,Ticket6
: : : :
当我准备处理它时，我将使用Split将每个字符串转换为一个数组。
如果您确认最多约10个代理商，每个代理商约5张票，我将讨论可能的HTML布局。如果有更多的代理商或票证，我会建议使用其他方法。
答案 1 :(得分：0)
因此，在经过反复试验之后，我创建了一些功能。我最终为Agent名称输入创建了一个字典，然后为要输入（重新分配）的票证嵌套了一个Collection。一些代码引用了全局变量，但这是此函数的主要模块。
Option Compare Text
Public Sub Handoff_Req()
Dim objSelection As Outlook.Selection
Dim objItem As Object
Set objOL = Outlook.Application
Dim olMsg As Outlook.MailItem
Dim olMsgReplyAll As Outlook.MailItem
Dim IsPlainText As Boolean
'Define Product
sProduct = "HANDOFF"
'Receive Incident Number as AlphaNumeric
sInc = Incident()
If sInc = "" Then
Exit Sub
End If
'Receive Severity level
Sev = 4
'Get reassigned tickets in loop
Dim dictReassignments As Scripting.Dictionary
Dim kagent As Variant
Set dictReassignments = New Scripting.Dictionary 'container for agents
Dim colTickets As New Collection 'container for tickets
Dim AgentCounter As Variant
Dim TicketCounter As Variant
Dim TenseCounter As Integer
TenseCounter = 0
'Get number of agents to reassign to
Line1: AgentCounter = InputBox("Input number of Agents that tickets are being reassigned to:", "Agent Reassignment Counter")
If Not IsNumeric(AgentCounter) Then
MsgBox (AgentCounter & " is not a number, please try again.")
GoTo Line1
Else
AgentCounter = CInt(AgentCounter)
End If
If AgentCounter > 5 Then
numa = MsgBox("Do you want to input more than " & TicketCounter & " tickets for " & kagent & "?", 4, "Correct ticket amount?")
If numa = 6 Then 'Yes
GoTo Line2 'Continue loop
ElseIf numa = 7 Then 'No
GoTo Line1 'Repeat agent counter question
End If
End If
Line2: While AgentCounter > 0
Set colTickets = New Collection
kagent = ValidateReassignedAgent
If kagent = "" Then
Exit Sub
End If
Line3: TicketCounter = InputBox("Input number of ticket(s) being reassigned to agent:", "Ticket Reassignment Counter")
If Not IsNumeric(TicketCounter) Then
MsgBox (TicketCounter & " is not a number, please try again.")
GoTo Line3
Else
TicketCounter = CInt(TicketCounter)
End If
If TicketCounter > 10 Then
numa = MsgBox("Do you want to input more than " & TicketCounter & " tickets for " & kagent & "?", 4, "Correct ticket amount?")
If numa = 6 Then 'Yes
GoTo Line4 'Continue loop
ElseIf numa = 7 Then 'No
GoTo Line3 'Repeat ticket counter question
End If
End If
Line4: While TicketCounter > 0
xInc = Reassignments()
If xInc = "" Then
MsgBox ("Please input a valid number")
End If
colTickets.Add xInc
TicketCounter = TicketCounter - 1
Wend
dictReassignments.Add kagent, colTickets
AgentCounter = AgentCounter - 1
Wend
'Check dictionary of agents
For Each agent In dictReassignments.Keys()
'MsgBox (agent)
sXferAgent = agent
For Each ticket In dictReassignments(agent)
'MsgBox (ticket)
TenseCounter = TenseCounter + 1
sINCs = ticket & ", " & sINCs
sTense = "have"
Next ticket
'MsgBox (TenseCounter)
If TenseCounter > 1 Then
sTense = " have"
sINCs = Left(sINCs, Len(sINCs) - 2)
sINCs = StrReverse(Replace(StrReverse(sINCs), StrReverse(", "), StrReverse(", and "), , 1))
Else
sTense = "has"
sINCs = Left(sINCs, Len(sINCs) - 2)
End If
sBody = "<p><span style=""font-size:11.0pt;font-family:"Calibri",sans-serif;mso-bidi-font-family:" & vbCrLf & _
"Arial"">" & sINCs & " " & sTense & " been reassigned to " & sXferAgent & " per hand-off process.<o:p></o:p></span></p>" & vbCrLf
scombined = sBody & scombined
TenseCounter = 0
sINCs = Null
sTense = Null
sXferAgent = Null
Next agent
'Process Agents for email inclusion
For Each agent In dictReassignments.Keys()
sXferAgent = agent
exAgent = AddXferRecip(sXferAgent)
sXferredAgents = exAgent & "; " & sXferredAgents
Next
'Find Logged in Agent
SDagent = LoggedIn
If SDagent = "" Then
Exit Sub
End If
'Set Category Color
Color = GetColor(SDagent)
If Color = "" Then
Exit Sub
End If
'Get the selected item
Select Case TypeName(objOL.ActiveWindow)
Case "Explorer"
Set objSelection = objOL.ActiveExplorer.Selection
If objSelection.Count > 0 Then
Set objItem = objSelection.Item(1)
Else
result = MsgBox("No item selected. " & _
"Please make a selection first.", _
vbCritical, "Reply All in HTML")
Exit Sub
End If
Case "Inspector"
Set objItem = objOL.ActiveInspector.CurrentItem
Case Else
result = MsgBox("Unsupported Window type." & _
vbNewLine & "Please make a selection" & _
" or open an item first.", _
vbCritical, "Reply All in HTML")
Exit Sub
End Select
'Change the message format and reply
If objItem.Class = olMail Then
Set olMsg = objItem
If olMsg.BodyFormat = olFormatPlain Then
IsPlainText = True
End If
olMsg.BodyFormat = olFormatHTML
Set olMsgReplyAll = olMsg.ReplyAll
If IsPlainText = True Then
olMsg.BodyFormat = olFormatPlain
End If
'Delete Automatic Signature
GlobalVars.DelSig olMsgReplyAll
'Remove Non-Monitored or Invalid email addresses
Dim recipremove As Variant
Dim element As Variant
recipremove = Array("IT Service Desk")
For lngCnt = olMsgReplyAll.Recipients.Count To 1 Step -1
Set olkrcp = olMsgReplyAll.Recipients.Item(lngCnt)
For Each element In recipremove
If olkrcp.Name = element Then
If olkrcp.Type = olTo Or olCC Then
olMsgReplyAll.Recipients.Item(lngCnt).Delete
End If
End If
Next element
Next
'Add recipients
exAgent = AddXferRecip(sXferredAgents)
'Set Recipients
Dim olRecip As Recipient ' Add Recipient
Set olRecip = olMsgReplyAll.Recipients.Add(sXferredAgents) 'add multiple agents assigned
olRecip.Resolve
'BCC to SharePoint for tracking
Set olRecip = olMsgReplyAll.Recipients.Add("Email Address")
olRecip.Type = olBCC
olRecip.Resolve
'Include SD Mgr if Sev 1
If Sev = "1" Then
Set olRecip = olMsgReplyAll.Recipients.Add("Email Address")
olRecip.Type = olBCC
olRecip.Resolve
End If
'Delete Duplicate addresses
Dim i As Integer, j As Integer
Dim olRecip1 As Recipient, olRecip2 As Recipient
Dim colRecipients As Recipients
Set colRecipients = olMsgReplyAll.Recipients
For i = colRecipients.Count To 1 Step -1
Set olRecip1 = colRecipients.Item(i)
For j = (i - 1) To 1 Step -1
Set olRecip2 = colRecipients.Item(j)
If olRecip1.Name = olRecip2.Name Then
If olRecip1.Type = olTo Or olCC Then
olRecip1.Delete
Exit For
End If
End If
Next
Next
'Format Subject Line
GlobalVars.SubjLine olMsgReplyAll
'Set Signature
sSig = SigAdd
'Set Body Reply
Dim sOpen As String, sAddendum As String, sClose As String 'Message Reply Format
sOpen = "<span style=""font-size:11.0pt;font-family:"Calibri",sans-serif;mso-bidi-font-family:" & vbCrLf & _
"Arial"">Team, <o:p></o:p></span>" & vbCrLf
sBody = scombined
sClose = "<p><span style=""font-size:11.0pt;font-family:"Calibri",sans-serif;mso-bidi-font-family:" & vbCrLf & _
"Arial"">Thanks & Regards,<o:p></o:p></span></p>" & vbCrLf & _
"<p><br/></p>"
olMsgReplyAll.HTMLBody = sOpen & sBody & sClose & sSig & olMsgReplyAll.HTMLBody
'Get Attachments
GlobalVars.CopyAttachments olMsg, olMsgReplyAll
'Set Category Color
olMsg.Categories = Color & ";Hand-off Notices"
'Display Reply
olMsg.Close (olSave)
olMsgReplyAll.Display
Dim oMail As Outlook.MailItem
'Selected item isn't a mail item
Else
result = MsgBox("No message item selected. " & _
"Please make a selection first.", _
vbCritical, "Reply All in HTML")
Exit Sub
End If
'Cleanup
Set objOL = Nothing
Set objItem = Nothing
Set objSelection = Nothing
Set olMsg = Nothing
Set olMsgReplyAll = Nothing
End Sub