Sub DraftStampsDelete_25_0303_1525()
Dim oStory As Range
Dim sShape As Shape
Dim strText As String
Dim i As Integer
    For Each oStory In ActiveDocument.StoryRanges
        For i = oStory.ShapeRange.Count To 1 Step -1
            Set sShape = oStory.ShapeRange(i)
            If sShape.TextFrame.HasText Then
                strText = sShape.TextFrame.TextRange.Text
                If UCase(Left(strText, 5)) = "DRAFT" Then sShape.Delete
            End If
        Next i
        If oStory.StoryType <> wdMainTextStory Then
            While Not (oStory.NextStoryRange Is Nothing)
                Set oStory = oStory.NextStoryRange
                For i = oStory.ShapeRange.Count To 1 Step -1
                    Set sShape = oStory.ShapeRange(i)
                    If sShape.TextFrame.HasText Then
                        strText = sShape.TextFrame.TextRange.Text
                        If UCase(Left(strText, 5)) = "DRAFT" Then sShape.Delete
                    End If
                Next i
            Wend
        End If
    Next oStory
lbl_Exit:
    Set oStory = Nothing
    Set sShape = Nothing
    Exit Sub
End Sub