Malicious Office (OOXML) / .DOC — malware analysis report

Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
'******************************************************************************
'******************************************************************************
'Version: 1.00
'Revision Author: Terry Minshall
'Revision Date: 01.07.03

'File Name: ThisDocument
'Owner:
'Purpose: Provide standard control and document tools
'Addtional Class Inclusions: none
'References: standard
'Assumptions: N/A
'Notes: read the comments on each procedure/ member for functionality
'Possible Enhancements:
'Definitions:
'******************************************************************************
'******************************************************************************

Option Explicit
Option Compare Text


'******************************************************************************
'                           CLASS CONSTANTS
'******************************************************************************

Private Const varName_RELOADPATH As String = "reloadPath"
'Private Const fp_TEMPDIR As String = "C:\Users\" & Environ("USERNAME") & "\AppData\Local\"
Private fp_TEMPDIR As String
'******************************************************************************
'                           CLASS STORAGE
'******************************************************************************
Private validStates As Variant

'******************************************************************************
'                           CLASS VARIALBE
'******************************************************************************



'******************************************************************************
'                     CLASS MEMBERS
'******************************************************************************

'Public Function hasFillMacroExecuted(ff As Integer) As Boolean
'   Dim x As Boolean
'   On Error GoTo EH_hasFillMacroExecuted
'   x = Trim(Me.FormFields(ff).Result) = Empty
'   If Not x Then _
'      Me.Bookmarks(Me.FormFields(ff).name).Range.Fields(1).Result.Select
'
'   hasFillMacroExecuted = x
'
'EH_hasFillMacroExecuted:
'End Function



Public Property Get reloadParentPath() As String
    reloadParentPath = docVar_Static_value(varName_RELOADPATH)
End Property

Public Property Let reloadParentPath(rp As String)
fp_TEMPDIR = "C:\Users\" & Environ("USERNAME") & "\AppData\Local\"
    docVar_Static_add varName_RELOADPATH, rp
End Property



'******************************************************************************
'                   PUBLIC DOCUMENT LEVEL PROCEDURES
'******************************************************************************


'******************************************************************************
'                      PRIVATE DOCUMENT LEVEL PROCEDURES
'******************************************************************************

Private Sub docVar_Static_add(ByVal varName As String, ByVal valueX As String)
    '*  All volatile variables will be prefaced with v_ to indicate its _
        Scope. All static document variables will be prefaced with _
        s_.
    '*
    Dim x As String
    
    On Error GoTo EH_docVar_Volatile_add
    varName = "s_" & varName
    
    On Error Resume Next
    x = Me.Variables(varName).Value
        
    If Err Then
        Err.Clear
        Me.Variables.Add name:=varName, Value:=valueX
    Else
        Me.Variables(varName).Value = valueX
    End If
    
    
EH_docVar_Volatile_add:
End Sub


Private Sub docVar_Static_removeAll()

    Dim v As Variable
    
    For Each v In ActiveDocument.Variables
        If Left(v.name, 2) = "s_" Then v.Delete
    Next v
    
End Sub

Private Function docVar_Static_value(ByVal varName As String) As String
    '*  All volatile variables will be prefaced with v_ to indicate its _
        Scope. All static document variables will be prefaced with _
        s_.
    '*
    Dim x As String
    
    On Error GoTo EH_docVar_Volatile_value
    docVar_Static_value = Empty
    varName = "s_" & varName
    
    On Error Resume Next
    docVar_Static_value = Me.Variables(varName).Value
        
    If Err Then Err.Clear
    
EH_docVar_Volatile_value:
End Function


Attribute VB_Name = "cfrmProcessNotification"
Attribute VB_Base = "0{5FE86A1A-6CCC-496F-9D5A-DD12A72CED7F}{412BBD41-BC8B-4D8E-BB0F-D684F6B6BB20}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False





Option Explicit

Public processType As Byte
Public processExec As Boolean
Public param_1 As Variant, param_2 As Variant



Private Sub UserForm_Activate()
   On Error GoTo EH_UserForm_Activate
      
   With Me
      Select Case processType
         'Case 1:
            'lblMessage.Caption = "Preparing Email..."
            '.Repaint
            'Application.screenRefresh
            'processExec = EmailProcedure_Alt
'         Case 2:
'            lblMessage.Caption = "Preparing Fax Document..."
'            .Repaint
'            Application.ScreenRefresh
'            processExec = prepareAgentFax(param_1, param_2)
         Case 3:                 'Scrubbing
            lblMessage.Caption = "Processing Document ..."
            .Repaint
            Application.ScreenRefresh
            RemoveEnter
            processExec = True
         'Case 4:                 'Matching all
         '   .Repaint
         '   Application.screenRefresh
         '   gDoc.ff_MatchAll_Inexplicit
         '   processExec = True
         End Select
      
      .Hide
   End With
   Exit Sub
   
EH_UserForm_Activate:
   Me.processExec = False
   Me.Hide
End Sub


Private Sub UserForm_Initialize()
   processType = 0
   processExec = False
End Sub

Private Sub UserForm_Terminate()
   Dim t As String
   Dim ct As Single
   t = lblMessage.Caption
   lblMessage.Caption = "Still processing..."
   
   ct = Timer + 0.5
   Do
   Loop While ct >= Timer
   lblMessage.Caption = t
   
   
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then Cancel = True
End Sub

Attribute VB_Name = "trav_Environment"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

'Version: 1.0
'Revision Author: Terry Minshall
'Revision Date: 09.23.02
'Revision Date:  12.16.03 PLPM4736 - Log #323 (correspondence)--Fix in regard to Central Print (Server/Printer)-kg

'File Name: trav_Environment
'Owner: EPUB Fillable Team
'Purpose: Provide access to the basic environment settings of the user
'Addtional Class Inclusions: none
'References: standard
'Assumptions: The local settings for the environment list have explicit titles
'   as used below in set_* procedures
'Notes: read the comments on each procedure/ member for functionality
'Possible Enhancements:
'Definitions:


Option Explicit
Option Compare Text
Option Base 1

Private Type BCServers
    BC As String
    Server1 As String
    Server2 As String
    Server3 As String
    Server4 As String
    Server5 As String
End Type

Private Type CentralPrinters
    Office As String
    Printer As String
End Type

Const mint_InitialArrLen As Integer = 199
Const mstrFile_BCServers As String = "P:\epubword\fillable\BCServerList.txt"
Const mstrFile_CentralPrinters As String = "P:\epubword\fillable\CentralPrinters.txt"

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'                         CLASS CONSTANTS
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Const PRINTER_ENUM_CONNECTIONS = 4 '&H4
Private Const PRINTER_ENUM_LOCAL = 2 '&H2

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'                         CLASS DECLARATIONS
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _
        (ByVal flags As Long, ByVal name As String, ByVal Level As Long, _
        pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, _
        pcReturned As Long) As Long

Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
        (ByVal RetVal As String, ByVal Ptr As Long) As Long

Private Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _
       (ByVal Ptr As Long) As Long
       
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'                         CLASS STRUCTURE
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Type mEnvironment
    short_name As String * 8
    nID As String * 6
    usr As String * 75
    BC As String * 20
    prnt_Default As String * 100
    prnt_Target As String * 100
    from_Email As String * 100
    signOnServer As String * 20
End Type

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'                         CLASS STORAGE
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private tEnv As mEnvironment
Private init_class As Boolean

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'                         CLASS CONSTRUCTORS
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub Class_Initialize()
'Constructor

    init_class = False
        
    On Error GoTo EH_Class_Initialize
    clear_Current_Record
    
    'Explicit order of setting environment. Assumptions made, see proceedures
    If Not (set_ShortName) Then GoTo EH_Class_Initialize
    If Not (set_NID) Then GoTo EH_Class_Initialize
    If Not (set_User) Then GoTo EH_Class_Initialize
    If Not (set_SignOnServer) Then GoTo EH_Class_Initialize
    If Not (set_BusinessCenter) Then GoTo EH_Class_Initialize
    If Not (set_DefaultPrinter) Then GoTo EH_Class_Initialize
    If Not (set_TargetPrinter) Then GoTo EH_Class_Initialize
    If Not (set_FromEmail) Then GoTo EH_Class_Initialize
    
    init_class = True
    
EH_Class_Initialize:
End Sub
Private Sub Class_Terminate()
'Destructor
    clear_Current_Record
End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'                         PUBLIC CLASS MEMBERS
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Public Property Get intialize() As Boolean
    intialize = init_class
End Property

Public Property Get nID() As String
    nID = Trim(tEnv.nID)
End Property

Public Property Get shortName() As String
    shortName = Trim(tEnv.short_name)
End Property

Public Property Get user() As String
    user = Trim(tEnv.usr)
End Property

Public Property Get business_Center() As String
    business_Center = Trim(tEnv.BC)
End Property
Public Property Get printer_Default() As String
    printer_Default = Trim(tEnv.prnt_Default)
End Property

Public Property Get printer_Target() As String
    printer_Target = Trim(tEnv.prnt_Target)
End Property

Public Property Get server_SignOn() As String
    server_SignOn = Trim(tEnv.signOnServer)
End Property
Public Property Get email_From() As String
    email_From = Trim(tEnv.from_Email)
End Property

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'               PUBLIC PROCEDURES
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Function isEmpty() As Boolean
    'Post: Returns true if the
    'Note: future version may want to test bc or nid instead or in addition to the
    '   below test
    isEmpty = (Trim(tEnv.usr) = Empty And Trim(tEnv.short_name) = Empty)
End Function


Public Function printer_List(pList() As String) As Boolean
'Post: Returns false if error occurs or no printer is found;
'       else true is returned
    
    Const ARRAY_BASE As Integer = 0

    Dim bSuccess As Boolean
    Dim iBufferRequired As Long, iBufferSize As Long, iEntries As Long, _
        iIndex As Long, iDummy As Long
    Dim Buffer() As Long, iDriverBuffer() As Long
    Dim strPrinterName As String
    Dim k As Integer
    
    printer_List = False
    On Error GoTo EH_PrinterList
    
    iBufferSize = 3072
    k = ARRAY_BASE - 1

    ReDim iBuffer(ARRAY_BASE To (iBufferSize \ 4) - 1) As Long

    'EnumPrinters will return a value False if the buffer is not big enough
    bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
        PRINTER_ENUM_LOCAL, vbNullString, 1, iBuffer(ARRAY_BASE), iBufferSize, iBufferRequired, iEntries)
    
    If Not bSuccess Then
        If iBufferRequired > iBufferSize Then
            iBufferSize = iBufferRequired
            ReDim iBuffer((iBufferSize \ 4) - 1) As Long
        End If
        'Try again with new buffer
        bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                PRINTER_ENUM_LOCAL, vbNullString, _
                1, iBuffer(ARRAY_BASE), iBufferSize, iBufferRequired, iEntries)
            
        If Not bSuccess Then Exit Function
    End If
    
    ReDim pList(ARRAY_BASE To (iEntries - 1)) As String
        
    'Enumprinters returned True, use found printers to fill the array
        
    For iIndex = ARRAY_BASE To (iEntries - 1)
        'Get the printername
        strPrinterName = Space$(StrLen(iBuffer(iIndex * 4 + 2)))
        iDummy = PtrToStr(strPrinterName, iBuffer(iIndex * 4 + 2))
        
        If strPrinterName <> "Fax" And InStr(1, strPrinterName, "Acrobat", vbTextCompare) = 0 Then
            k = k + 1
            pList(k) = strPrinterName
        End If
        
    Next iIndex
    
    ReDim Preserve pList(ARRAY_BASE To k) As String
    printer_List = True
    WordBasic.sortarray pList()
    Exit Function
    
EH_PrinterList:
    Err.Clear
End Function




'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'                   PRIVATE PROCEDURES
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub clear_Current_Record()
'Null initializes all class variables

    tEnv.nID = Empty
    tEnv.short_name = Empty
    tEnv.usr = Empty
    tEnv.BC = Empty
    tEnv.prnt_Default = Empty
    tEnv.prnt_Target = Empty
    tEnv.signOnServer = Empty
    tEnv.from_Email = Empty
    
End Sub

Private Function isBounded(vArray As Variant) As Boolean
    'Insure that
    'If the variant passed to this function is an array, the function will return True;
    'otherwise it will return False
    On Error Resume Next
    isBounded = IsNumeric(UBound(vArray))
End Function


Private Function set_ShortName() As Boolean
'Author: Terry Minshall
'Purpose: sets private class varible .short_name to current environment shortname

    '***Const ttl As String = "U_Shortname"
    Const ttl As String = "USERNAME"
    
    set_ShortName = False
    On Error GoTo EH_Set_Shortname
    
    set_ShortName = False
    tEnv.short_name = return_Environment_Value(ttl)
    If tEnv.short_name = Empty Then Exit Function
    set_ShortName = True
    
    
EH_Set_Shortname:
End Function

Private Function set_NID() As Boolean
'Author: Terry Minshall
'Purpose: sets private class varible .nID to current environment nid

    Const ttl As String = "U_NID"
    
    set_NID = False
    On Error GoTo EH_Set_NID

    tEnv.nID = return_Environment_Value(ttl)
    If tEnv.nID = Empty Then Exit Function
    set_NID = True

        
EH_Set_NID:
End Function

Private Function set_SignOnServer() As Boolean
'Post: Sign on server is set and true is returned; else false is returned
    Const title As String = "s_svrhom"
    
    set_SignOnServer = False
    On Error GoTo EH_Set_SignOnServer
    
    
    tEnv.signOnServer = return_Environment_Value(title)
    If Trim(tEnv.signOnServer) = Empty Then Exit Function
    
    set_SignOnServer = True
    
    
EH_Set_SignOnServer:
End Function
Private Function set_User() As Boolean
'Author: Terry Minshall
'Purpose: Return the local N id number on PC

    Const title As String = "USERNAME"
    
    set_User = False
    On Error GoTo EH_Set_User
    
    tEnv.usr = return_Environment_Value(title)
    If tEnv.usr = Empty Then Exit Function
    set_User = True
    
    
EH_Set_User:
End Function

Private Function set_BusinessCenter() As Boolean
    
'Assumption: tEnv.signonServer is initialized

Dim musr_BCServerArray() As BCServers
Dim i As Integer
Dim intFileNum As Integer
Dim mint_BCServerLen As Integer

    ReDim musr_BCServerArray(1 To mint_InitialArrLen) As BCServers
    
    intFileNum = FreeFile
    i = 0
    set_BusinessCenter = False
    On Error GoTo EH_Set_BusinessCenter
        
    Open mstrFile_BCServers For Input Shared As intFileNum
         Do While Not (EOF(intFileNum))
            i = i + 1
            Input #intFileNum, musr_BCServerArray(i).BC, musr_BCServerArray(i).Server1, _
                musr_BCServerArray(i).Server2, musr_BCServerArray(i).Server3, _
                musr_BCServerArray(i).Server4, musr_BCServerArray(i).Server5
        
        Select Case Trim(tEnv.signOnServer)
        Case musr_BCServerArray(i).Server1, musr_BCServerArray(i).Server2, _
            musr_BCServerArray(i).Server3, musr_BCServerArray(i).Server4, _
            musr_BCServerArray(i).Server5:

            '+++++++++++++++++++++++++++++++++++++++++++++++++++++
            'Added for Spokane to Houston Printing - 11/13/06 - pa
                If musr_BCServerArray(i).BC = "Spokane" And gSrg.variable_ValueVolatile(ThisDocument, "BusCenter") = "Houston" Then
                    musr_BCServerArray(i).BC = "SpokaneH"
                End If
            '++++++++++ end of insert code ++++++++++++++++++++++++

            tEnv.BC = musr_BCServerArray(i).BC
            GoTo BCServerMatch
        End Select
    Loop
    
    tEnv.BC = Empty

BCServerMatch:
    Close #intFileNum
    mint_BCServerLen = i
    ReDim Preserve musr_BCServerArray(1 To mint_BCServerLen) As BCServers
    
    set_BusinessCenter = True
    
EH_Set_BusinessCenter:
End Function

Private Function set_DefaultPrinter() As Boolean

    set_DefaultPrinter = False
    On Error GoTo EH_Set_DefaultPrinter
    tEnv.prnt_Default = Application.ActivePrinter
    
    set_DefaultPrinter = True
EH_Set_DefaultPrinter:
End Function

Private Function set_TargetPrinter() As Boolean

Dim musr_CentralPrinterArray() As CentralPrinters
Dim i As Integer
Dim intFileNum As Integer
Dim mint_BCPrinterLen As Integer

    ReDim musr_CentralPrinterArray(1 To mint_InitialArrLen) As CentralPrinters
    
    intFileNum = FreeFile
    i = 0
    set_TargetPrinter = False
    On Error GoTo EH_Set_TargetPrinter
        
    Open mstrFile_CentralPrinters For Input Shared As intFileNum
         Do While Not (EOF(intFileNum))
            i = i + 1
            Input #intFileNum, musr_CentralPrinterArray(i).Office, musr_CentralPrinterArray(i).Printer
        Select Case Trim(tEnv.BC)
        Case musr_CentralPrinterArray(i).Office:
            tEnv.prnt_Target = musr_CentralPrinterArray(i).Printer
            GoTo CentralPrintMatch
        End Select
    Loop
    
    tEnv.prnt_Target = tEnv.prnt_Default

CentralPrintMatch:
    Close #intFileNum
    mint_BCPrinterLen = i
    ReDim Preserve musr_CentralPrinterArray(1 To mint_BCPrinterLen) As CentralPrinters
    
    set_TargetPrinter = True

EH_Set_TargetPrinter:
End Function
Private Function set_FromEmail() As Boolean

'Assumption: Business center tEnv.bc is initialized

    set_FromEmail = False
    On Error GoTo EH_set_FromEmail

    Select Case Trim(tEnv.BC)
        Case "Fall River":
            tEnv.from_Email = "PLSERV@travelers.com"
        Case "Glens Falls":
            tEnv.from_Email = "PLSERV@travelers.com"
        Case "Houston":
            tEnv.from_Email = "PLSERV@travelers.com"
        Case "Knoxville":
            tEnv.from_Email = "PLSERV@travelers.com"
        Case "Spokane":
            tEnv.from_Email = "PLSERV@travelers.com"
        Case "Syracuse":
            tEnv.from_Email = "PLSERV@travelers.com"
        Case "Tampa":
            tEnv.from_Email = "PLSERV@travelers.com"
        Case "Premier":
            tEnv.from_Email = "PLSERV@travelers.com"
        Case "Home Office1":
            tEnv.from_Email = "PLSERV@travelers.com"
        Case "Home Office2":
            tEnv.from_Email = "PLSERV@travelers.com"
        Case "Home Office3":
            tEnv.from_Email = "PLSERV@travelers.com"
        Case Else:
            'tEnv.from_Email = Empty
            tEnv.from_Email = "PLSERV@travelers.com"
            Exit Function
    End Select
    
    set_FromEmail = True
EH_set_FromEmail:
End Function

Private Function return_Environment_Value(ByVal ttl As String) As String
    'Assumption: an '=' sign seperates the value and the environment title
    
    Dim ttl_len As Integer        'Title Length
    Dim env As String
    Dim i As Integer
    Dim t As String
    
    return_Environment_Value = Empty
    
    ttl = ttl & "="
    ttl_len = Len(ttl)
    
    On Error GoTo EH_Return_Environment_Value
    i = 1
    Do
        
        env = Environ(i)
        If Len(env) <= ttl_len Then GoTo WRAP
        t = Left(env, ttl_len)
        If t = ttl Then
            return_Environment_Value = Right(env, (Len(env) - ttl_len))
            GoTo EH_Return_Environment_Value
        End If
WRAP:
        i = i + 1
    Loop Until env = ""
    
    ttl = Empty
    
EH_Return_Environment_Value:
End Function

Attribute VB_Name = "frmContactInfo"
Attribute VB_Base = "0{2719BC4F-340D-4BE3-B818-735C278F593D}{6657DDA7-8016-435E-AF42-56485B7F7F90}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
''''''3/18/02 - 1st Time or if UndName.txt (on M/My Documents) is deleted:
''''''          Contact Information frm appears
''''''          Business Center Name & Contact Phone Number appear, can't edit on frm
''''''          Type in your name or select Terry Collins
''''''          2ND TIME
''''''          The 3 fields mentioned above are placed directly on .doc
''''''          Fields CAN BE edited on .doc
''''''
''''''
'''''Option Explicit
'''''
'''''Private Sub cmdNext_Click()
'''''
'''''If hasError Then GoTo FINISH
'''''
'''''    Open "m:\UndName.txt" For Output As #1
'''''        Print #1, cboUndName
'''''    Close #1
'''''
'''''    Unload frmContactInfo
'''''
'''''OUT:
'''''
'''''FINISH:
'''''End Sub
'''''
'''''Private Function hasError() As Boolean
'''''
'''''    If Trim(cboUndName) = Empty Then
'''''        hasError = True
'''''        Call ErrorNotification(1)
'''''        cboUndName.SetFocus
'''''    Else
'''''        hasError = False
'''''    End If
'''''
'''''
'''''End Function
'''''Private Sub ErrorNotification(ByVal intErrorNum As Integer)
'''''    Dim strmessage As String
'''''    Dim strtitle As String
'''''
'''''    strtitle = "Invalid Data"
'''''
'''''    Select Case (intErrorNum)
'''''
'''''        Case 1:
'''''            strmessage = "Please fill in all fields before continuing."
'''''            MsgBox strmessage, vbExclamation, strtitle
'''''        Case 2:
'''''            strmessage = "Please verify the information entered into selected field."
'''''            MsgBox strmessage, vbExclamation, strtitle
'''''    End Select
'''''End Sub
'''''
'''''Private Sub UserForm_Initialize()
'''''
''''''    cboUndName.AddItem "Terry Collins"
'''''
'''''    txtUndPhone = ActiveDocument.FormFields("BCPhone").Result
'''''    txtBCName2 = ActiveDocument.FormFields("BCName").Result
''''''    txtBCName2 = BusinessCenterName
'''''
'''''End Sub
'''''
'''''Private Sub cmdCancel_Click()
'''''
'''''    Dim Message As String
'''''    Dim title As String
'''''    Dim Response As Variant
'''''
'''''Message = "This form cannot be used without macro completion. Would you like to exit this form?"
'''''title = "Macro Termination"
'''''Response = MsgBox(Message, vbYesNo, title)
'''''
'''''If Response = 6 Then
'''''    Unload frmContactInfo
'''''    Call EndFormFillingSub
'''''
'''''End If
'''''
'''''End Sub
'''''
'''''Private Sub cmdExit_Click()
'''''    Unload frmContactInfo
'''''    Call EndFormFillingSub
'''''End Sub
'''''Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'''''    If CloseMode = vbFormControlMenu Then 'Cancel = False
'''''        Unload Me
'''''        Call EndFormFillingSub
'''''    End If
'''''End Sub
'''''
Private Sub cmdNext_Click()

End Sub

Attribute VB_Name = "StartFormFilling"
 Option Explicit
' forces you to have variables that have no case sensitivity
Option Compare Text

Public Const varname_AgtAreaCode As String = "agtArea_fax"
Public Const varname_AgtExchange As String = "agtExchange_fax"
Public Const varname_AgtNumber As String = "agtNumber_fax"

Public gDFTool As New trav_DataFile 'g preface states global scope

Public OfficeType As String
Public BusinessCenter As String
Public BusinessCenterName As String
Public BusinessCenterCityStZip As String
Public StateAcct As String
Public PolicyNumber2 As String
Public LineOfBusinessCode As String
Public LineOfBusiness As String
Public CompanyName As String
Public UndName As String
Public BCPhone As String
Public MAILTO As String

Public DocExists As Boolean
Public gSelectorDoc As Document
Public gSelectorName As String
Public blnSaveToPDF As Boolean

Public Sub StartFormFilling()

'This procedure was not working as an AutoOpen proc from Browser 5.0
'I added a field on top of for user to click into and tab out of to
'kick off Macros.  The Macro was renamed StartFormFilling and the field was
'named StartFormField
'The Form Reload feature will need to be recoded accordingly
'After the logo goes onto the form but before it get's protected again
'I have to remove the default text: Click Here to Start...
'on the final document  That code was placed on the code associated with
'frmDivisionProp    Dan Guinan 6/20/2000 4:57
'''     '-+<
   With ThisDocument.CommandBars("Document Options")
      .Visible = True
      .Protection = msoBarNoProtection
      .Left = 0
   End With
   '>
ThisDocument.CommandBars("Standard").Visible = False

   '+
   'store the true path to this document as fax, save & email funtions may
   'change the parent path
   ThisDocument.reloadParentPath = ThisDocument.FullName
    
   ActiveDocument.FormFields("IssueDate").Result = Date

'''Log# 2380
'''    Load frmBCName
'''    frmBCName.Show
    Load frmGeneralInfo
    frmGeneralInfo.Show
'''Log# 2380

End Sub

Sub CompleteForm()
    If ActiveDocument.FormFields("startformfield").Result = ".." Then
        MsgBox "This Document For Faxing ONLY", vbExclamation, "Faxing Message"
        GoTo OUT
    End If
    
    If ActiveDocument.FormFields("startformfield").Result = "TAB TO BEGIN FORM FILL-IN" Then
        MsgBox "This Document Has NOT Been Properly Filled Out", vbExclamation, "Faxing Message"
        GoTo OUT
    End If

    Load frmPrintDoc
    frmPrintDoc.Show
        
OUT:
End Sub
Public Sub AutoOpen()
    If Trim(ActiveDocument.FormFields("IName").Result) = "" Then Call StartFormFilling
End Sub


Attribute VB_Name = "DocumakerCPrintV6"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'DocumakerCPrintV5
'Written:  9-14-2007  Revised 10-26-2007 5:35
'Author:   Dan Guinan
'Moved the LOGO_CODE, ENV_INSERT, INITIALS, FORMID & FORM_NUMBER  TO DOC PROPERTIES
'wasn't working good in a form fields
'Need to remember to populate it if the logo or return envelope changes based on the user
'selections, specifically, it could be by business center for return envelope? (10-12-2007)
'
'10-17-2007, Added sequence numbering for our own internal tests, uses the users local temp dir
'Added XML safing just for our own internal tests, don't need it with SOSA DLL
'10-22-2007, Moved the form number and initials below form tag so it prints on all pages.
'10-26-2007, Added code for dealing with additional pages without footers
'A NEW CustomDocumentProperty created, called INSERTS, if = "NONE" or enter the
'exact name of the FAP this code created for P11253 to add FAP P11253P2
'Note the change in the DocumakerGroupXML function
'10-31-2007 fixed typo in the INSERT Form call in the XML
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function DocumakerGroupXML()
Dim f As Integer
Dim FAPNumber As String
Dim TempGroupXML As String



'This next section of properties will generate the GROUP node of the Documaker XML
'this part of the xml will be derived from the DOC PROPERTIES AT PRINT TIME
'Note that the DOC PROPERTIES FapTotalComplete must be "YES" for this to work
'This design will allow the Word Doc developer to dynamically build the sections
'using FAPs for documents with inserted .rtf type files
'This function should be called when the document is ready to be sent to Docucorp
'It will return the XML for the GROUP node which includes the dynamic make-up of FAPs if dynamic
'I am Adding some FIELDS HERE RATHER THAN ADDING THEM TO THE WORD DOC AS FORM FIELDS to preceed the
'group xml
'LOGO_CODE, ENV_INSERT, FORM_NUMBER, INTITIALS
'I post values here rather than trying to put these values into form fields

TempGroupXML = "<FIELD NAME=" & Chr(34) & "ENV_INSERT" & Chr(34) & ">" & ThisDocument.CustomDocumentProperties("ENV_INSERT").Value & "</FIELD>" & _
"<FIELD NAME=" & Chr(34) & "LOGO_CODE" & Chr(34) & ">" & ThisDocument.CustomDocumentProperties("LOGO_CODE").Value & "</FIELD>"

'now add the groupname and form name

'include the form number and initials because they are form level on the fap

TempGroupXML = TempGroupXML & "<GROUP NAME=" & Chr(34) & "" & Chr(34) & " NAME1=" & Chr(34) & "PL" & Chr(34) & " NAME2=" & Chr(34) & "FILLABLE" & Chr(34) & ">" & _
"<FORM NAME=" & Chr(34) & ThisDocument.CustomDocumentProperties("FORMNAME").Value & Chr(34) & ">" & _
"<FIELD NAME=" & Chr(34) & "FORM_NUMBER" & Chr(34) & ">" & ThisDocument.CustomDocumentProperties("FORM_NUMBER").Value & "</FIELD>" & _
"<FIELD NAME=" & Chr(34) & "INITIALS" & Chr(34) & ">" & ThisDocument.CustomDocumentProperties("INITIALS").Value & "</FIELD>"

TempGroupXML = TempGroupXML & "<DESCRIPTION>EFT FORM</DESCRIPTION>" & _
"<RECIPIENT NAME=" & Chr(34) & "INSURED" & Chr(34) & " COPYCOUNT=" & Chr(34) & "1" & Chr(34) & "/><SHEET><PAGE>"




If ThisDocument.CustomDocumentProperties("FAPTotalComplete").Value Then  'Is the FAPTotalComplete YES OR NO
    'THIS section of the XML will be derived from the CustomDocumentProperties
    'run through this loop the number of times we have a FAP Total for
    For f = 1 To ThisDocument.CustomDocumentProperties("FAPTotal").Value
        FAPNumber = "FAP_" & Trim(Str(f))
        TempGroupXML = TempGroupXML & "<SECTION NAME=" & Chr(34) & ThisDocument.CustomDocumentProperties(FAPNumber).Value & Chr(34) & "/>"
    Next f 'increment through all the FAPS based on the FAPTotal  FAP_1 thru FAP_999
    'Now I wrote out all the FAPS in numerical order, so I can close the XML tags
Else
    'The DocProperties Have Not Been Set Up Properly so we need to generate a Documaker Error
    'You can not call the DocumakerGroupXML function unless your FAPTotalComplete = YES
    'and you should have incremented the FAPTotal if you dynamically added any
    TempGroupXML = TempGroupXML & "<SECTION NAME=" & Chr(34) & "FAPERROR" & Chr(34) & "/>"
    MsgBox "Your FAPs are not completely assembled, contact EPUB...", vbOKOnly
End If

If ThisDocument.CustomDocumentProperties("INSERTS").Value = "NONE" Then
    'Close the tags and the GROUP XML IS COMPLETE
    TempGroupXML = TempGroupXML & "</PAGE></SHEET></FORM></GROUP>"
    DocumakerGroupXML = TempGroupXML
Else
    'Add some more XML for the insert specified in the DocumentProperties
    'This function will tack on some more XML to the GROUP XML so an insert or attachment
    'can be added without continuing the footer or page numbering.
    'This would only be used for something like the EFT sheet that the customer is supposed to
    'return to Travelers.  There will be many more convenient uses of this features after Wave1
    'XML I need to code is shown below
    '<FORM NAME="INSERT">
    '<DESCRIPTION>EFT FORM</DESCRIPTION>
…