Рассылка сообщений с вложениями через Outlook с помощью vbscript

Автоматизируем работу менеджеров!
За стиль программирования прошу сильно не пинать,
но скрипт работает.



Dim objExcel, objOutlook, objItem, MailItem, strPath, strExcelPath, objSheet, intRow, strCompDN, objAttachments

    On Error Resume Next
        Set objExcel = CreateObject("Excel.Application")
        If (Err.Number <> 0) Then
           On Error GoTo 0
           Wscript.Echo "Excel не найден."
           Wscript.Quit
        End If
    On Error GoTo 0
    strPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(Wscript.ScriptFullName)
    strExcelPath = strPath & "\Клиенты.xls"
      
    objExcel.WorkBooks.Open strExcelPath
    Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
    intRow = 1

    Do While objSheet.Cells(intRow, 1).Value <> ""
        Set objOutlook = CreateObject("Outlook.Application")
        If (Err.Number <> 0) Then
           On Error GoTo 0
           Wscript.Echo "Outlook не найден."
           Wscript.Quit
        End If
    On Error GoTo 0
    Set objItem = objOutlook.CreateItem(MailItem)
        objItem.Subject = objSheet.Cells(intRow, 2).Value
        objItem.Body = objSheet.Cells(intRow, 3).Value
        Set objAttachments = objItem.Attachments
        objAttachments.Add strPath & "\" & objSheet.Cells(intRow, 1).Value, olByValue, 1, strPath & "\" & objSheet.Cells(intRow, 1).Value
        objItem.Recipients.Add (objSheet.Cells(intRow, 4).Value)
        objItem.Save
        objItem.Send
        intRow = intRow + 1
    Loop

objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
objOutlook.Application.Quit

Set objExcel = Nothing
Set objSheet = Nothing
Set objOutlook = Nothing
Set objItem = Nothing
Set objAttachments = Nothing

Wscript.Echo "Готово!"