[Iska]

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

Мне вот не нравится, что Вы не используете тэг [code] для оформления кода на конференции, что не используете отступы в коде (или это следствие неиспользования тэга).

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

Код:

Код:

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

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