pshik » 10.09.2005 (Сб) 21:59
решил проблему
код внизу
Set olApp = CreateObject("Outlook.Application")
Set myFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(6)
Set myFileFolder = myFolder.folders(sFolder)
Set myItem = myFileFolder.items
For i = 1 To myItem.Count
Set myItem = myFileFolder.items(i)
Application.StatusBar = "Reading Outlook folder " & sFolder & " information..."
Set myAttachments = myItem.Attachments
sBody = myItem.body
str = "AP Invoice:"
iSer = InStr(sBody, str)
iSer = iSer + 12
sTitle = Mid(sBody, iSer, 23)
sTitle = Trim(sTitle)
Application.StatusBar = "Found file information " & sTitle & "...."
For x = 1 To myAttachments.Count
sAttName = myAttachments.Item(x).displayname
If LCase(Left(sAttName, 3)) = "exp" Then
sAttName = "Expenses-"
Else
sAttName = "Labour-"
End If
myAttachments.Item(x).SaveAsFile strPath & "\" & sAttName & "" & sTitle & ".xls "
Next
Next