Outlinker-form-code.bas

From ActivityOwnerWiki
Jump to: navigation, search
The code below is for reference only.  It is installed with the associated form.  It should not be installed alone.

'Outlinker Form Code
Option Explicit
Const OutLinkerFormVersion = "20090405"

Private Sub apptButton_Click()
 exitoutlinkerform ("ca")
End Sub

Private Sub ArchiveAllButton_Click()
    Archive
End Sub

Private Sub archivebutton_Click()
    exitoutlinkerform ("a")
End Sub



Private Sub ArchiveFolderButton_Click()
    Dim temp As Outlook.MAPIFolder
    Set temp = archivefolder1
    Set archivefolder1 = Application.GetNamespace("MAPI").PickFolder
    If Not archivefolder1 Is Nothing Then
        ArchiveFolderButton1.Caption = archivefolder1.Parent.Name & ":" & archivefolder1.Name
        sset "ArchiveStoreID", archivefolder1.StoreID
        sset "ArchiveFolderID", archivefolder1.EntryID
    Else
        Set archivefolder1 = temp
    End If
End Sub

Private Sub ArchiveFolderButton2_Click()
    Dim temp As Outlook.MAPIFolder
    Set temp = archivefolder2
    Set archivefolder2 = Application.GetNamespace("MAPI").PickFolder
    If Not archivefolder2 Is Nothing Then
        ArchiveFolderButton2.Caption = archivefolder2.FolderPath
        sset "ArchiveStore2ID", archivefolder2.StoreID
        sset "ArchiveFolder2ID", archivefolder2.EntryID
    Else
        Set archivefolder2 = temp
    End If
End Sub

Private Sub ArchiveFolderButton3_Click()
    Dim temp As Outlook.MAPIFolder
    Set temp = archivefolder3
    Set archivefolder3 = Application.GetNamespace("MAPI").PickFolder
    If Not archivefolder3 Is Nothing Then
        ArchiveFolderButton3.Caption = archivefolder3.FolderPath
        sset "ArchiveStore3ID", archivefolder3.StoreID
        sset "ArchiveFolder3ID", archivefolder3.EntryID
    Else
        Set archivefolder3 = temp
    End If
End Sub

Private Sub ArchiveFolderButton4_Click()
    Dim temp As Outlook.MAPIFolder
    Set temp = archivefolder4
    Set archivefolder4 = Application.GetNamespace("MAPI").PickFolder
    If Not archivefolder4 Is Nothing Then
        ArchiveFolderButton4.Caption = archivefolder4.FolderPath
        sset "ArchiveStore4ID", archivefolder4.StoreID
        sset "ArchiveFolder4ID", archivefolder4.EntryID
    Else
        Set archivefolder4 = temp
    End If
End Sub
Private Sub ArchiveFolderButton5_Click()
    Dim temp As Outlook.MAPIFolder
    Set temp = archivefolder5
    Set archivefolder5 = Application.GetNamespace("MAPI").PickFolder
    If Not archivefolder5 Is Nothing Then
        ArchiveFolderButton5.Caption = archivefolder5.FolderPath
        sset "ArchiveStore5ID", archivefolder5.StoreID
        sset "ArchiveFolder5ID", archivefolder5.EntryID
    Else
        Set archivefolder5 = temp
    End If
End Sub
Private Sub autoOutlinkerAllButton_Click()
    autoOutlinker
End Sub

Private Sub cancelButton_Click()
    exitoutlinkerform ("")
End Sub

Private Sub ComposeButton_Click()
    exitoutlinkerform ("c")
End Sub
Private Sub currentmessagestatslabel_Click()
  updateformstats
End Sub


Private Sub DeleteButton_Click()
        exitoutlinkerform ("d")
End Sub
Private Sub ForwardButton_Click()
    exitoutlinkerform ("f")
End Sub
Private Sub ForwardDeleteButton_Click()
    exitoutlinkerform ("fd")
End Sub
Private Sub ForwardSaveButton_Click()
    exitoutlinkerform ("fs")
End Sub
Private Sub gdeleteButton_Click()
    exitoutlinkerform ("g")
End Sub

Private Sub Frame2_Click()

End Sub

Private Sub Label2_Click()
   showoutlinkerhelp
End Sub

Private Sub nextthreadButton_Click()
    exitoutlinkerform ("nt")
End Sub
Private Sub OptionButton2_Click()

End Sub



Private Sub notagButton_Click()

End Sub

Private Sub prevButton_Click()
    exitoutlinkerform ("p")
End Sub
Private Sub goto1stButton_Click()
    exitoutlinkerform ("1")
End Sub
Private Sub helpButton_Click()
    showoutlinkerhelp
End Sub
Private Sub MindReadButton_Click()
    exitoutlinkerform (nextactionTextBox.text & "[bpgq]")
End Sub
Private Sub nextactionTextBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 If KeyCode = 13 Then
        exitoutlinkerform (nextactionTextBox.text)
 End If
End Sub
Private Sub nextButton_Click()
    exitoutlinkerform ("n")
End Sub
Private Sub EnterButton_Click()
    exitoutlinkerform (nextactionTextBox.text)
End Sub
Private Sub openAttachmentButton_Click()
    OpenAttachment obj, 1
End Sub

Private Sub prevthreadButton_Click()
    exitoutlinkerform ("pt")
End Sub

Private Sub QueueButton_Click()
  exitoutlinkerform (nextactionTextBox.text)
End Sub
Private Sub replyallButton_Click()
  exitoutlinkerform ("ra")
End Sub
Private Sub replyalldeleteButton_Click()
 exitoutlinkerform ("rad")
End Sub
Private Sub ReplyAllSaveButton_Click()
    exitoutlinkerform ("ras")
End Sub
Private Sub replyButton_Click()
  exitoutlinkerform ("r")
End Sub
Private Sub ReplyDeleteButton_Click()
 exitoutlinkerform ("rd")
 End Sub
Private Sub replysaveButton_Click()
  exitoutlinkerform ("rs")
End Sub
Private Sub sendButton_Click()
    exitoutlinkerform (nextactionTextBox.text & "[s2am]")
End Sub
Private Sub SetupButton_Click()
 showsettings
End Sub
Private Sub skipButton_Click()
 exitoutlinkerform ("s")
End Sub

Private Sub statsButton_Click()
 displaystats settings
End Sub


Private Sub tasklistButton_Click()
    exitoutlinkerform (nextactionTextBox.text & "[s2tl]")
End Sub
'
'Changing Items
'
Private Sub deadlineCheckBox_change()
    updateformstats
    togglekeyword deadlineCheckBox, codedeadline
End Sub
Private Sub delegateButton_change()
    setresource
End Sub
Private Sub nextmonthButton_Change()
  togglekeyword nextmonthButton, codenextmonth
End Sub
Private Sub nextweekButton_Change()
  togglekeyword nextweekButton, codenextweek
End Sub
Private Sub a15mButton_Change()
    togglekeyword a15mButton, code15m
End Sub
Private Sub a1hButton_Change()
    togglekeyword a1hButton, code1h
End Sub
Private Sub a2hButton_Change()
    togglekeyword a2hButton, code2h
End Sub
Private Sub olcabutton_Change()
    setresource
End Sub
Private Sub oliobutton_change()
    setresource
End Sub
Private Sub olwfButton_Change()
    setresource
End Sub
Private Sub addresseeCheckBox_Change()
    setresource
    setrelationmap
End Sub
Private Sub doneButton_change()
    togglekeyword doneButton, codeisdone
End Sub
Private Sub infobutton_Change()
    togglekeyword infoButton, codeisinfo
End Sub
Private Sub actionButton_change()
    togglekeyword actionButton, ""
End Sub
Private Sub priority3button_change()
    togglekeyword priority3button, codep3
End Sub
Private Sub priority2button_change()
    togglekeyword priority2Button, codep2
End Sub
Private Sub priority1button_change()
    togglekeyword priority1Button, codep1
End Sub
Private Sub noprioritybutton_change()
    togglekeyword nopriorityButton, ""
End Sub
Private Sub projectButton_change()
  togglekeyword projectButton, codeisproject
End Sub
Private Sub putmsginnoteCheckBox_Change()
    setboolean "PutMsgInNote", putmsginnoteCheckBox.value
End Sub
Private Sub attachCheckBox_Change()
    setboolean "attachmsg", attachCheckBox.value
End Sub
Private Sub relationmapCheckBox_change()
    setrelationmap
End Sub
Private Sub somedayCheckBox_change()
    updateformstats
    togglekeyword somedayCheckBox, codesomeday
End Sub
Private Sub context1Button_change()
    togglekeyword context1Button, gset("context1")
End Sub
Private Sub context2Button_change()
    togglekeyword context2button, gset("context2")
End Sub
Private Sub context3Button_change()
    togglekeyword context3Button, gset("context3")
End Sub
Private Sub context4Button_change()
    togglekeyword context4Button, gset("context4")
End Sub
Private Sub context5Button_change()
    togglekeyword context5Button, gset("context5")
End Sub
Private Sub context6Button_change()
    togglekeyword Context6Button, gset("context6")
End Sub
Private Sub context7Button_change()
    togglekeyword Context7Button, gset("context7")
End Sub
Private Sub context8Button_change()
    togglekeyword Context8Button, gset("context8")
End Sub
Private Sub context9Button_change()
    togglekeyword Context9Button, gset("context9")
End Sub




Private Sub tag1CheckBox_change()
    togglekeyword tag1CheckBox, gset("tag1")
End Sub
Private Sub tag2CheckBox_change()
    togglekeyword tag2CheckBox, gset("tag2")
End Sub
Private Sub tag3CheckBox_change()
    togglekeyword tag3CheckBox, gset("tag3")
End Sub
Private Sub tag4CheckBox_change()
    togglekeyword tag4CheckBox, gset("tag4")
End Sub
Private Sub tag5CheckBox_change()
    togglekeyword tag5CheckBox, gset("tag5")
End Sub
Private Sub tag6CheckBox_change()
    togglekeyword tag6CheckBox, gset("tag6")
End Sub

Private Sub tag7CheckBox_change()
    togglekeyword Tag7CheckBox, gset("tag7")
End Sub
Private Sub tag8CheckBox_change()
    togglekeyword tag8CheckBox, gset("tag8")
End Sub
Private Sub tag9CheckBox_change()
    togglekeyword Tag9CheckBox, gset("tag9")
End Sub
Private Sub tag10CheckBox_change()
    togglekeyword Tag10CheckBox, gset("tag10")
End Sub
Private Sub tag11CheckBox_change()
    togglekeyword Tag11CheckBox, gset("tag11")
End Sub
Private Sub tag12CheckBox_change()
    togglekeyword Tag12CheckBox, gset("tag12")
End Sub
Private Sub tag13CheckBox_change()
    togglekeyword tag13CheckBox, gset("tag13")
End Sub
Private Sub tag14CheckBox_change()
    togglekeyword tag14CheckBox, gset("tag14")
End Sub
Private Sub tag15CheckBox_change()
    togglekeyword Tag15CheckBox, gset("tag15")
End Sub
Private Sub tag16CheckBox_change()
    togglekeyword Tag16CheckBox, gset("tag16")
End Sub
Private Sub tag17CheckBox_change()
    togglekeyword Tag17CheckBox, gset("tag17")
End Sub
Private Sub tag18CheckBox_change()
    togglekeyword Tag18CheckBox, gset("tag18")
End Sub
Private Sub tag19CheckBox_change()
    togglekeyword tag19CheckBox, gset("tag19")
End Sub
Private Sub tag20CheckBox_change()
    togglekeyword Tag20CheckBox, gset("tag20")
End Sub



Private Sub threadzoomButton_Click()
    If iszoomed Then
        unthreadzoom iszoomed
        threadzoomButton.Caption = "Zoom"
    Else
        threadzoom obj, iszoomed
        threadzoomButton.Caption = "UnZoom"
    End If
    updateformstats
End Sub

Private Sub todayButton_Change()
    updateformstats
    togglekeyword todayButton, CodeToday
End Sub
Private Sub tomorrowButton_change()
    updateformstats
    togglekeyword tomorrowButton, CodeTomorrow
End Sub
'
'Other Functions
'
Private Sub exitoutlinkerform(ByRef cmd As String)
   nextaction = cmd
   sset "formleft", Str(OutLinkerForm.Left)
   sset "formtop", Str(OutLinkerForm.Top)
   Unload OutLinkerForm
End Sub


Private Sub UseArchive1Button_Click()
    setboolean "usearchive1", UseArchive1Button.value
    setboolean "usearchive2", UseArchive2Button.value
    setboolean "usearchive3", UseArchive3Button.value
    setboolean "usearchive4", UseArchive4Button.value
    setboolean "usearchive5", UseArchive5Button.value
End Sub
Private Sub UseArchive2Button_Click()
    setboolean "usearchive1", UseArchive1Button.value
    setboolean "usearchive2", UseArchive2Button.value
    setboolean "usearchive3", UseArchive3Button.value
    setboolean "usearchive4", UseArchive4Button.value
    setboolean "usearchive5", UseArchive5Button.value
End Sub
Private Sub UseArchive3Button_Click()
    setboolean "usearchive1", UseArchive1Button.value
    setboolean "usearchive2", UseArchive2Button.value
    setboolean "usearchive3", UseArchive3Button.value
    setboolean "usearchive4", UseArchive4Button.value
    setboolean "usearchive5", UseArchive5Button.value
End Sub
Private Sub UseArchive4Button_Click()
    setboolean "usearchive1", UseArchive1Button.value
    setboolean "usearchive2", UseArchive2Button.value
    setboolean "usearchive3", UseArchive3Button.value
    setboolean "usearchive4", UseArchive4Button.value
    setboolean "usearchive5", UseArchive5Button.value
End Sub
Private Sub UseArchive5Button_Click()
    setboolean "usearchive1", UseArchive1Button.value
    setboolean "usearchive2", UseArchive2Button.value
    setboolean "usearchive3", UseArchive3Button.value
    setboolean "usearchive4", UseArchive4Button.value
    setboolean "usearchive5", UseArchive5Button.value
End Sub



Private Sub UserForm_activate()
    Dim useaddressee As Boolean
    nextactionTextBox.SelStart = 0
    nextactionTextBox.SelLength = Len(nextactionTextBox.text)
    If outlooktasklist.Items.count > 0 Then
        tasklistButton.Caption = "TaskList (" & Trim(Str(outlooktasklist.Items.count)) & ")"
    End If
    useaddressee = False
    On Error Resume Next
    useaddressee = (obj.Parent.Name = gset("sentitemsfolder")) Or (extractname(Outlook.Application.GetNamespace("MAPI").CurrentUser.Name) = getsendername(obj))
    On Error GoTo 0
    If Not Err.Number = 0 Then Err.Clear
    addresseeCheckBox.value = useaddressee
    updateformstats
    nextactionTextBox.SetFocus
End Sub
Private Sub userform_mousemove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  updateformstats
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 If CloseMode = 0 Then Cancel = True
End Sub

Sub updateformstats()
 StatusLabel.Caption = gset("todaycount") + " done " + Str(itemsleft(gone, totalitems)) + " left"
 currentmessagestatslabel.Caption = "Time(sec):|This:" + timesincelastprompt + "|Last:" + Str(lastprocess) + "|Avg " + Str(Round(avgprocess, 0))
 If Val(timesincelastprompt) > 120 Then
    currentmessagestatslabel.ForeColor = vbRed
End If
 SkipLabel.Caption = skiptext(obj)
End Sub

Sub setrelationmap()
    Dim addressee As String
    Dim sender As String
    addressee = getaddresseename(obj)
    sender = getsendername(obj)
    nextactionTextBox.text = Replace(nextactionTextBox.text, addressee & "map", "")
    nextactionTextBox.text = Replace(nextactionTextBox.text, sender & "map", "")
    nextactionTextBox.text = Replace(nextactionTextBox.text, "[]", "")
    If relationmapCheckBox.value = True Then
        If addresseeCheckBox.value Then
            nextactionTextBox.text = nextactionTextBox.text & "[" & addressee & "map]"
        Else
            nextactionTextBox.text = nextactionTextBox.text & "[" & sender & "map]"
        End If
     End If
End Sub
Private Sub setresource()
    Dim addressee As String
    Dim sender As String
    addressee = getaddresseename(obj)
    sender = getsendername(obj)
    'take everything out
    nextactionTextBox.text = Replace(nextactionTextBox.text, "[" & codewaitingfor & addressee & "]", "")
    nextactionTextBox.text = Replace(nextactionTextBox.text, "[" & codewaitingfor & sender & "]", "")
    nextactionTextBox.text = Replace(nextactionTextBox.text, "[" & CodeIOwe & " " & addressee & "]", "")
    nextactionTextBox.text = Replace(nextactionTextBox.text, "[" & CodeIOwe & " " & sender & "]", "")
    nextactionTextBox.text = Replace(nextactionTextBox.text, "[" & CodeDelegatedTo & " " & sender & "]", "")
    nextactionTextBox.text = Replace(nextactionTextBox.text, "[" & CodeDelegatedTo & " " & addressee & "]", "")
    nextactionTextBox.text = Replace(nextactionTextBox.text, "[" & addressee & "@]", "")
    nextactionTextBox.text = Replace(nextactionTextBox.text, "[" & sender & "@]", "")
    If addresseeCheckBox.value = True Then
        If olcaButton.value = True Then
            nextactionTextBox.text = nextactionTextBox.text & "[" & addressee & "@]"
        ElseIf olwfButton.value = True Then
            nextactionTextBox.text = nextactionTextBox.text & "[" & codewaitingfor & addressee & "]"
        ElseIf olioButton.value = True Then
            nextactionTextBox.text = nextactionTextBox.text & "[" & CodeIOwe & " " & addressee & "]"
        ElseIf delegateButton.value = True Then
            nextactionTextBox.text = nextactionTextBox.text & "[" & CodeDelegatedTo & " " & addressee & "]"
        End If
    Else
        If olcaButton.value = True Then
            nextactionTextBox.text = nextactionTextBox.text & "[" & sender & "@]"
        ElseIf olwfButton.value = True Then
            nextactionTextBox.text = nextactionTextBox.text & "[" & codewaitingfor & sender & "]"
        ElseIf olioButton.value = True Then
            nextactionTextBox.text = nextactionTextBox.text & "[" & CodeIOwe & " " & sender & "]"
        ElseIf delegateButton.value = True Then
            nextactionTextBox.text = nextactionTextBox.text & "[" & CodeDelegatedTo & " " & sender & "]"
        End If
    End If

End Sub

Sub togglekeyword(ByRef control As control, ByRef keyword As String)
 If control.value = True Then
        If Not InStr(nextactionTextBox.text, keyword) > 0 Then
            nextactionTextBox.text = nextactionTextBox.text & "[" & keyword & "]"
        End If
    ElseIf control.value = False Then
        If InStr(nextactionTextBox.text, keyword) > 0 Then
            nextactionTextBox.text = Replace(nextactionTextBox.text, keyword, "")
        End If
    End If
    If InStr(nextactionTextBox.text, "[]") > 0 Then nextactionTextBox.text = Replace(nextactionTextBox.text, "[]", "")
    If InStr(nextactionTextBox.text, "[*]") > 0 Then nextactionTextBox.text = Replace(nextactionTextBox.text, "[*]", "")
End Sub