[Iska]

Sta1917, не хотите выкладывать — дело Ваше.

Вот Вам код:

читать дальше »

Код:

Option Explicit

Private Sub Document_Open()
    Dim objRange As Range
    Dim objFSO As Object
    Dim objFile As Object
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    With ThisDocument
        If .Bookmarks.Exists("_DwgProp") Then
            With .Bookmarks.Item("_DwgProp").Range
                .Expand Unit:=wdTable
                .Tables.Item(1).Delete
            End With
        End If
        
        Set objRange = .Content
        objRange.Collapse Direction:=wdCollapseStart
        
        With .Tables.Add(Range:=objRange, NumRows:=3, NumColumns:=2)
            .Cell(1, 1).Range.Text = "Название файла"
            .Cell(2, 1).Range.Text = "Дата и время последнего изменения"
            .Cell(3, 1).Range.Text = "Объем файла"
            
            For Each objFile In objFSO.GetFolder(.Parent.Path).Files
                If UCase(objFSO.GetExtensionName(objFile.Name)) = UCase("dwg") Then
                    .Cell(1, 2).Range.Text = objFile.Name
                    .Cell(2, 2).Range.Text = CStr(objFile.DateLastModified)
                    .Cell(3, 2).Range.Text = CStr(objFile.Size)
                    
                    Exit For
                End If
            Next objFile
            
            Set objRange = .Range
        End With
        
        .Bookmarks.Add Name:="_DwgProp", Range:=objRange
        
        Set objRange = Nothing
    End With
    
    Set objFSO = Nothing
End Sub

Добавляйте его в модуль «ThisDocument» Вашего документа «Паспорт.doc» и правьте по собственному усмотрению.