Private Sub WtoE()
'nnn = Application.GetOpenFilename
'If nnn = False Then
'    End
'End If

Dim wdApp As Object
Dim wdDoc As Object
    Set wdApp = CreateObject("Word.Application")
    Set wdDoc = wdApp.Documents.Open(Filename:=nnn)
'если надо, чтобы word был виден при открытии, то
'wdApp.Visible = True

'процедура ищет дату в Word
    With wdApp.Selection.Find
        .Text = "[0-9]{2}.[0-9]{2}.[0-9]{4}"
        .MatchWildcards = True
    End With
wdApp.Selection.Find.Execute
wdApp.Selection.copy
    
    
wdDoc.Close
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing

End Sub