Sub SilverBullet()

'Connection to Oracle with OO4O (Oracle object for OLE)
'Tools -> References.. -> Select <Oracle InProc Server 5.0 Type Library>
Dim oraSession  As Object
Dim oraDatabase As Object
Dim OraDynaset As OraDynaset
Dim OraFields As OraFields
Dim FieldDoc, FieldPol, FieldStat As String
Dim DocName As String

Dim strDocName As String
Dim strPath As String
Dim ldDoc As Document
Dim strAnyWord As String

'for testing
Dim lines() As String
Dim text1 As String

    Set ldDoc = ActiveDocument
'File name without extention .doc or .docx
    strDocName = Left(ldDoc.Name, InStr( 1 , ldDoc.Name, ".") -  1 )

'Fullpath of file
    strPath = ldDoc.Path
    'strAny = ldDoc.Content  'Insert text from file in object
    strAnyWord = "Aieoiaio:"
       
    Set oraSession = CreateObject("OracleInProcServer.XOraSession")
'Connection parameter
    Set oraDatabase = oraSession.OpenDatabase("landocst", "dbo/dbo",  0 )
    'MsgBox "Connected to " & oraDatabase.Connect & "@" & oraDatabase.DatabaseName

'Create the OraDynaset Object.
'if you are not call parameter for Bind variable, your SQl statment will ejected error
    oraDatabase.Parameters.Add "var1", strDocName,  1 
    
    Set OraDynaset = oraDatabase.CreateDynaset(" SELECT ver.""FileName"" as NameDoc, voc.""Name"" as Pol, stat.""Name"" as StatName " _
   & "FROM dbo.ldmail mail, DBO.LDERC erc, DBO.LDMAILSTATE stat, DBO.LDVOCABULARY voc, DBO.ldversion ver " _
   & "WHERE erc.""ID"" = mail.""ERCID"" AND ver.""FileName"" = :var1 AND erc.""ID"" = ver.""DocID"" AND erc.""JournalID"" = 340470 " _
   & " AND mail.""ReceiverID"" = voc.""ID"" AND mail.""MailStateID"" in (2,4,6) AND mail.""MailTypeID"" = 340468 AND mail.""MailStateID"" = stat.""ID"" ",  0 &)

'You can now display or manipulate the data in the dynaset. For example:
    Do While Not OraDynaset.EOF
        Set OraFields = OraDynaset.Fields
        FieldPol = OraFields("Pol").Value
        FieldStat = OraFields("StatName").Value
        lines() = Split(strAnyWord & " " & strDocName & " " & FieldPol & " -> " & FieldStat, "")
        'text1 = text1 & vbCrLf & FieldPol & FieldStat
        text1 = lines(i) & vbCrLf & text1
        OraDynaset.MoveNext
        Loop
        
'Insert data in textbox
    With ldDoc.Shapes.AddTextbox(msoTextOrientationHorizontal,  320 ,  780 ,  280 ,  50 )
        .LockAspectRatio = msoTrue
        .LockAspectRatio = msoTrue
        .Line.Visible = msoFalse    'Hide lines
        .TextFrame.TextRange.Text = text1
        .TextFrame.TextRange.Font.Name = "Times New Romans"  'Font
        .TextFrame.TextRange.Font.Size =  8      'Size font
        .TextFrame.AutoSize = True      'Autosize textbox
        '.TextFrame.VerticalAnchor = msoAnchorBottom
    End With
    
End Sub

    If ThisDocument.Saved = True Then
    ldDoc.Close wdDoNotSaveChanges
    Else
    End If

Private Sub Document_Close()
Dim ldDoc As Document

Set ldDoc = ThisDocument

ActiveDocument.Undo  7  'ровно столько изменений требуется для вставки моего textbox

   If Not ldDoc.Undo = True Then
        MsgBox "No save"
    ldDoc.Close (wdDoNotSaveChanges)
    Else
           MsgBox "Yes save"
    End If

End Sub

Sub AddColontitul()

Dim oraSession  As Object
Dim oraDatabase As Object
Dim OraDynaset As OraDynaset
Dim OraFields As OraFields
Dim FieldRec As String
Dim FieldCnt As String

Dim strPath As String
Dim ldDoc As Document
Dim strDocNameWithoutExt As String
Dim strDocName1, strDocName2, strDocID As String
Dim strDocName3, strDocName As String
Dim lines() As String
Dim text1 As String
Dim Foot As HeaderFooter
Dim mytxtbox As Shape

    Set ldDoc = ActiveDocument
'-----------------------Get FileName without extention----------------
    strDocNameWithoutExt = Left(ldDoc.Name, InStr( 1 , ldDoc.Name, ".") -  1 )
    MsgBox strDocNameWithoutExt
    
'------------------------Get only ID from FileName--------------------
    strDocName1 = InStr( 1 , StrReverse(strDocNameWithoutExt), "(")
    strDocName2 = Right(strDocNameWithoutExt, strDocName1 -  1 )
    strDocID = Trim(Left(strDocName2, InStr( 1 , strDocName2, "_") -  1 ))

'----------------------------Get only FileName------------------------
    strDocName3 = Right(strDocNameWithoutExt, strDocName1 -  0 )
    strDocName = Trim(Replace(strDocNameWithoutExt, strDocName3, ""))
    
'------------------------Oracle Connection parameter------------------
    Set oraSession = CreateObject("OracleInProcServer.XOraSession")
    Set oraDatabase = oraSession.OpenDatabase("landocs2.keramin.int", "otchetman/loop",  0 )
    'MsgBox "Connected to " & oraDatabase.Connect & "@" & oraDatabase.DatabaseName

'------------------------Check type document--------------------------
    oraDatabase.Parameters.Add "var1", strDocID,  1 
    
       Set OraDynaset = oraDatabase.CreateDynaset(" SELECT count(ver.""ID"") as Cnt " _
        & "FROM dbo.ldmail mail, DBO.LDERC erc, DBO.ldversion ver " _
        & "WHERE erc.""ID"" = mail.""ERCID"" AND ver.""ID"" = :var1 " _
        & "AND erc.""ID"" = ver.""DocID"" " _
        & "AND mail.""MailStateID"" in (2,4,6) AND mail.""MailTypeID"" = 340468 " _
        & "AND ver.""VerN"" in (select max(ver.""VerN"") FROM dbo.ldmail mail, DBO.LDERC erc, DBO.ldversion ver " _
        & "WHERE erc.""ID"" = mail.""ERCID"" AND ver.""ID"" = :var1 " _
        & "AND erc.""ID"" = ver.""DocID"" " _
        & "AND mail.""MailStateID"" in (2,4,6) AND mail.""MailTypeID"" = 340468) ",  0 &)
       
       Set OraFields = OraDynaset.Fields
       FieldCnt = OraFields("Cnt").Value
       
'---------------------Main condition for working macros---------------
    If FieldCnt >  0  Then

'--------------------Execute sql-function-----------------------------
        Set OraDynaset = oraDatabase.CreateDynaset("select dbo.LDF_LDDOC_TYPE( :var1 ) as vRec from dual",  0 &)
        
'----------------------Get returned value-----------------------------
        Set OraFields = OraDynaset.Fields
        FieldRec = OraFields("vRec").Value

'---------------------Reaction by return value------------------------
        If FieldRec =  1  Then
            Stat = "Согласовано"
        ElseIf FieldRec =  2  Then
            Stat = "Не согласовано"
        Else
            Stat = "Ошибка!"
        End If
    
        lines() = Split(Left(strDocName,  100 ) & "  " & Stat, vbCrLf)
        text1 = Trim(lines(i))
        
'-----------------------Create Footer---------------------------------
       With ldDoc.Sections( 1 ).Footers(wdHeaderFooterPrimary)
        With .Range
            .Text = text1
            With .Font
                .Color = wdColorBlack
                .Name = "Times New Roman"
                .Size =  9 
            End With
          End With
        End With
        
'-----------------------If main condition is False--------------------
    Else
    MsgBox "По документу нет согласований"
    End If
    
    ldDoc.Saved = True

End Sub