时间戳

首页 > 解决方案 > 多维数据输入

arrays - 多维数据输入

问题描述

我目前被困在如何实现在 VBA 中获取和存储信息的过程。

客观的：

目前，我有一个函数可以获取代理名称 (isagent(sAgent)) 并验证它，获取票号 (Incident()) 并验证它，并使用字符串回复消息以格式化消息 ( s身体）。

问题：

输入数据的存储容器是我的保留。我不认为数组是一个正确的选择，因为代理的数量和每个代理的票数每天都会波动。

例如：昨天的请求：将工单 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 个人

代码：

本节为Message body格式，可以组合成一个字符串（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:&quot;Calibri&quot;,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:&quot;Calibri&quot;,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:&quot;Calibri&quot;,sans-serif;mso-bidi-font-family:" & vbCrLf & _
            "Arial"">Thanks &amp; 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

标签： arraysvbacollectionsoutlook

解决方案

所以经过大量的试验和错误，我创造了一些功能性的东西。我最终为代理名称输入创建了一个字典，然后嵌套了一个 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:&quot;Calibri&quot;,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:&quot;Calibri&quot;,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:&quot;Calibri&quot;,sans-serif;mso-bidi-font-family:" & vbCrLf & _
            "Arial"">Thanks &amp; 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

推荐阅读