Тестовый код (целиком) под спойлером.
Тестовый проект и пример проблемного письма (оригинал) во вложении
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
Option Explicit
' Reference to Microsoft ActiveX Data Objects 2.5 Library
' Reference to Microsoft CDO for Windows 2000 Library
Public Type MsgInfo
Sender As String
Subject As String
Body As String
attach As String
End Type
Sub Main()
MsgBox Command
GetMsgInfoCDO Command
End Sub
Public Function GetMsgInfoCDO(MsgFile As String) As MsgInfo
Dim att
Dim str As String, strATT As String
Dim mmm As CDO.Message
strATT = ""
Set mmm = LoadMessageFromFile(MsgFile)
str = mmm.From
If InStr(str, "<") > 0 Then 'нужен только e-mail
str = Trim(Right(str, Len(str) - InStr(str, "<")))
str = Trim(Left(str, InStr(str, ">") - 1))
End If
GetMsgInfoCDO.Sender = str
GetMsgInfoCDO.Subject = mmm.Subject
GetMsgInfoCDO.Body = mmm.TextBody
MsgBox "sender=" & GetMsgInfoCDO.Sender & ";subject=" & _
GetMsgInfoCDO.Subject & ";subject=" & GetMsgInfoCDO.Body
For Each att In mmm.Attachments
If Len(strATT) > 0 Then
strATT = strATT & ";" & att.FileName
Else
strATT = att.FileName
End If
MsgBox "attach=" & Chr(34) & att.FileName & Chr(34) & " (len=" & Len(att.FileName) & ")"
att.SaveToFile App.Path & "\" & att.FileName
'только первое вложение пока
'Exit For
Next
GetMsgInfoCDO.attach = strATT
End Function
Function LoadMessageFromFile(Path As String) As Message
Dim Stm As New Stream
Stm.Open
Stm.LoadFromFile Path
Dim iMsg As New CDO.Message
Dim iDsrc As IDataSource
Set iDsrc = iMsg
iDsrc.OpenObject Stm, "_Stream"
Set LoadMessageFromFile = iMsg
End Function
Клиент конечно намудрил но ошибка характерная:
Во вложении файл "Scan sa kopirke RUDOLF.eml"
И сдается что это все-таки не по хорватски а по англиски написано (перенастройка системы на Languages->Advanced-> Croatian во всяком случае не помогает).
А проблема такая:
Код
1.
2.
For Each att In mmm.Attachments
strATT = att.FileName
возвращает пустую строку вместо имени аттачмента
а код
1.
att.SaveToFile App.Path & "\attach\" & att.FileName
соответственно вылетает с ошибкой
"The system can not find the file specified" (системе не удается найти путь)
В принципе на худой конец (нежелательно но можно) могу генерировать свое имя attachment-а
Но мне надо знать хотя б расширение аттачмента,
потому как далее по коду аттачмент отправляется на печать через printto а это depends on расширение файла (которое по смыслу приложения допустимо любое, но знать то надо)
Если не решается, то остается только отбрасывать такие письма со соей ошибкой "не возможно прочитать имя вложения", но не желательно опять же...
Подскажет кто? Желательно решение, кот. не зависит от языка в системе и языка в письме.
