Function Rename(oDoc As Document) As Boolean
    On Error GoTo Err_Handler

    Dim oTable As Table
    Dim oTable2 As Table
    Dim oCell As Range
    If oDoc.Tables.Count = 0 Then GoTo Err_Handler
    Set oTable = oDoc.Tables(1)
    Set oTable2 = oTable.Range.Cells(4).Tables(1)
    Set oCell = oTable2.Range.Cells(6).Range
    oCell.End = oCell.End - 1
    oDoc.SaveAs Filename:=oDoc.Path & Chr(92) & Replace(oCell.Text, "/", "") & ".docx"
    Rename = True
lbl_Exit:
    Exit Function
Err_Handler:
    Rename = False
End Function