Помогите оптимизировать

[nasedkin]

Dim objTextStream, TXT
Set objTextStream = CreateObject("Scripting.FileSystemObject").GetFile("E:\REGL\SEND\telo1.txt").OpenAsTextStream(1)
TXT = objTextStream.ReadAll()
objTextStream.Close
Set objTextStream = Nothing
dim Mas()
Set objShellApp = CreateObject("Shell.Application")
FolderPath = "E:\REGL\SEND\"
Set objFolderItems = objShellApp.NameSpace(FolderPath).Items()
objFolderItems.Filter 64, "*.xls"
n = 0
For Each objFolderItem In objFolderItems
n = n +1
ReDIM Preserve Mas(n)
Mas(n)=objFolderItem.Path
Next
strDate=date
strTime=time
Dim oMyMail
Set oMyMail = CreateObject("CDO.Message")
oMyMail.To = "mail@mail.ru"
oMyMail.From = "Информация <robot@mail.ru>"
oMyMail.Subject = "Изменение цены от " & strTime & " " & strDate & "."
oMyMail.TextBody = TXT
lft=LBound(Mas)
rgt=UBound(Mas)
For i=lft To rgt
oMyMail.AddAttachment Mas(i)
next
oMyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
omyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.ru"
oMyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
oMyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "robot@mail.ru"
oMyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
oMyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
oMyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
oMyMail.Configuration.Fields.Update
oMyMail.Send

Dim oFSO
Dim sDirectoryPath
Dim oFolder
Dim oDelFolder
Dim oFileCollection
Dim oFile
Dim oFolderCollection
Set oFSO = CreateObject("Scripting.FileSystemObject")
sDirectoryPath = "E:\REGL\SEND\"
set oFolder = oFSO.GetFolder(sDirectoryPath)
set oFolderCollection = oFolder.SubFolders
set oFileCollection = oFolder.Files
for each oFile in oFileCollection
oFile.Delete(True)
Next
For each oDelFolder in oFolderCollection
oDelFolder.Delete(True)
Next
Set oFSO = Nothing
Set oFolder = Nothing
Set oFileCollection = Nothing
Set oFile = Nothing


================
Скрипт прикрепляет как вложения файлы из папки E:\REGL\SEND\, вставляет текст из файла E:\REGL\SEND\telo1.txt в тело письма, в теме письма отображается число, месяц, год, часы, минуты, секунды отправления письма. Затем из папки E:\REGL\SEND все файлы удаляются.

[Iska]

nasedkin, что именно Вам не нравится в коде?

Мне вот не нравится, что Вы не используете тэг (http://forum.oszone.net/misc.php?do=bbcode#code) для оформления кода на конференции, что не используете отступы в коде (или это следствие неиспользования тэга).

Не нравится, что никак не проверяется существование файла «E:\REGL\SEND\telo1.txt», существование пути «E:\REGL\SEND» перед попыткой их использования. Вместо использования массива и «ReDim Preserve» лучше использовать коллекцию (словарь).

Код:
[code]lft=LBound(Mas)
rgt=UBound(Mas)
For i=lft To rgt
oMyMail.AddAttachment Mas(i)
next
чересчур излишен. Есть вариант куда проще:
For Each elem In Mas
oMyMail.AddAttachment elem
Next
Последнее:
Set oFSO = CreateObject("Scripting.FileSystemObject")
sDirectoryPath = "E:\REGL\SEND\"
set oFolder = oFSO.GetFolder(sDirectoryPath)
set oFolderCollection = oFolder.SubFolders
set oFileCollection = oFolder.Files
for each oFile in oFileCollection
oFile.Delete(True)
Next
For each oDelFolder in oFolderCollection
oDelFolder.Delete(True)
Next
также можно сократить до:
oFSO.GetFolder(sDirectoryPath)

For each oFile in oFolder.Files
oFile.Delete(True)
Next

For each oDelFolder in oFolder.SubFolders
oDelFolder.Delete(True)
Next


Ну, и дважды создаётся объект «Scripting.FileSystemObject» — не есть хорошо.

[nasedkin]

Dim objTextStream, TXT
FolderPath = "d:\dd\"

dim Mas2()
Set objShellApp = CreateObject("Shell.Application")
Set objFolderItems = objShellApp.NameSpace(FolderPath).Items()
objFolderItems.Filter 64, "*.txt"
MM = 0
For Each objFolderItem In objFolderItems
MM = MM +1
ReDIM Preserve Mas2(MM)
Mas2(MM)=objFolderItem.Path
Next
TXT=""
For ii=1 to MM
Set objTextStream = CreateObject("Scripting.FileSystemObject").GetFile(MAS2(II)).OpenAsTextStream(1)
TXT = TXT+objTextStream.ReadAll()
MsgBox TXT
objTextStream.Close
Set objTextStream = Nothing
NEXT

dim Mas()
Set objShellApp = CreateObject("Shell.Application")
Set objFolderItems = objShellApp.NameSpace(FolderPath).Items()
objFolderItems.Filter 64, "*.xls"
n = 0
For Each objFolderItem In objFolderItems
n = n +1
ReDIM Preserve Mas(n)
Mas(n)=objFolderItem.Path
Next

strDate=date
strTime=time
Dim oMyMail
Set oMyMail = CreateObject("CDO.Message")
oMyMail.To = "mail@mail.ru"
oMyMail.From = "Информация <robot@mail.ru>"
oMyMail.Subject = "Изменение цены от " & strTime & " " & strDate
oMyMail.TextBody = TXT

For i=1 To N
oMyMail.AddAttachment Mas(i)
next
oMyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
omyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.ru"
oMyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
oMyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "robot@mail.ru"
oMyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
oMyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
oMyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
oMyMail.Configuration.Fields.Update
oMyMail.Send



теперь еще дополнительно парсит несколько текстовых файлов и собирает их в тело письма