VBScript SMTP Авто Email

Question

У меня есть скрипт для автоматической электронной почте список адреса, хранящегося в Excel, но только отправка по первому адресу, а не зацикливание к остальным, я не могу это исправить:

Set objMessage = CreateObject("CDO.Message") 
Set app = CreateObject("Excel.Application") 
Set fso = CreateObject("Scripting.FileSystemObject") 

For Each f In fso.GetFolder("Y:\Billing_Common\autoemail").Files 
    If LCase(fso.GetExtensionName(f)) = "xls" Then 
    Set wb = app.Workbooks.Open(f.Path) 

set sh = wb.Sheets("Auto Email Script") 
row = 2 
email = sh.Range("A" & row) 
LastRow = sh.UsedRange.Rows.Count 

Const ForReading = 1, ForWriting = 2, ForAppending = 8 
Dim f         
Set f = fso.OpenTextFile("Y:\Billing_Common\autoemail\Script\Email.txt", ForReading)           
BodyText = f.ReadAll 

For r = row to LastRow 
    If App.WorkSheetFunction.CountA(sh.Rows(r)) <> 0 Then 
    objMessage.Subject = "Billing: Meter Read" 
    objMessage.From = "billing@energia.ie" 
    row = row + 1 
    objMessage.To = email 
    objMessage.TextBody = BodyText 

objMessage.Configuration.Fields.Item _ 
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 


'Name or IP of Remote SMTP Server 
objMessage.Configuration.Fields.Item _ 
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "SERVER ADDRESS HERE" 

'Server port 
objMessage.Configuration.Fields.Item _ 
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 

objMessage.Configuration.Fields.Update 
objMessage.Send 

    End if 
Next 

f.Close 
Set f = Nothing 
Set fso = Nothing 
wb.Close 
End If 
Next 

Любая помощь была бы оценена ребятами!

Спасибо!

Answer 1

row = 2 
email = sh.Range("A" & row) 
... 
For r = row to LastRow 
    ... 
    objMessage.To = email 
    ... 
Next 

Вы устанавливаете email к значению ячейки "A2" и никогда не менять. Если вы хотите отправить почту нескольким получателям, вы должны сделать что

objMessage.To = sh.Range("A" & r).Value 

или (лучше) построить список получателей (при условии, что ваш используемый диапазон начинается с заголовками в первой строке таблицы):

ReDim recipients(LastRow - row) 
For r = row To LastRow 
    recipients(r - row) = sh.Range("A" & r).Value 
Next 
objMessage.To = Join(recipients, ";") 

и отправьте сообщение только один раз. MTA справится с остальными.

---

Примечание стороны:, как Вишну Прасад Kallummel отметил в комментариях код не закрывает экземпляр Excel запущенное. В отличие от других объектов, созданных в VBScript, офисные приложения не будут автоматически прекращается со сценарием, так что вы должны справиться сами:

... 
wb.Close 
app.Quit