Gremlin19
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
' To Turn On Debug Change Dim Debug from False to True in mDebug function
Sub mDebug(Text)
Dim Debug
Debug = True
If Debug Then
WScript.Echo Text
End If
End Sub
Sub save_new()
On Error Resume Next
Dim myApp 'As Outlook.Application
Dim myFolder 'As Outlook.MAPIFolder
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(6) '.Folders("1")
DestFolder = "C:\Scripts\"
' myFolder.Items.Sort "ReceivedTime", false
If myFolder.Items.Count > 0 Then
For i = 1 To myFolder.Items.Count
If (myFolder.Items(i).Attachments.Count > 0) and (myFolder.Items(i).Unread = True) Then
For j = 1 To myFolder.Items(i).Attachments.Count
mDebug(myFolder.Items(i).Subject & " " & myFolder.Items(i).CreationTime)
myFolder.Items(i).Attachments.Item(j).SaveAsFile DestFolder & _
left(myFolder.Items(i).CreationTime,10) & "_" & _
myFolder.Items(i).Attachments.Item(j).DisplayName
Next
End If
if Err.Number <> 0 Then
mDebug("Error on :" & myFolder.Items(i).Subject)
Err.Clear
end if
Next
End If
End Sub
mDebug("Start")
save_new()
mDebug("Done") |
