Option Explicit
Sub Auto_open()
    Dim wb As Workbook, bClosed As Boolean, ar As Range, c As Range, dtRazn%, s$, msg$
    On Error Resume Next
    Set wb = Workbooks("Карточка учета.xlsm")
    On Error GoTo 0
    If wb Is Nothing Then
        Application.ScreenUpdating = False
        Set wb = Workbooks.Open("C:\Учет страховых полисов\Карточка учета.xlsm")
        wb.Windows(1).Visible = 0
        Application.ScreenUpdating = True
        bClosed = True
    End If
    
    For Each ar In ['[Карточка учета.xlsm]ОСАГО'!D:D].SpecialCells(2, 1).Areas
        For Each c In ar.Cells
            dtRazn = c - Date
            s = ""
            Select Case dtRazn
                Case Is < 0: s = "На " & Abs(dtRazn) & "дн. просрочен "
                Case 0: s = "Сегодня заканчивается "
                Case Is <= 5: s = "Через " & dtRazn & " дн. заканчивается "
            End Select
            If s <> "" Then msg = msg & IIf(msg <> "", vbCrLf, "") & s & _
                "страховой полис ОСАГО на автомобиль " & c.Offset(, -2) & _
                " регистрационный номер " & c.Offset(, -3)
        Next
    Next
    If msg <> "" Then MsgBox msg: Debug.Print msg
    If bClosed Then wb.Close False
End Sub

For Each ar In ['[Карточка учета.xlsm]ОСАГО'!D:D].SpecialCells(2, 1).Areas