Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub view_attachments()
'***************************************************************
' ver. 1/24/04
' - Select one or multiple emails.
' - Files are copied to Temporary Internet folders.
' - Only image files are displayed (no others are executed).
' - Right-click images to 'Save As', 'Email', etc.
' - Hover over image to see original size & scaled size.
' - Clicking each image will toggle between original size
' & browser width (unless original size is smaller).
' - To scale all images to browser width, resize the browser,
' right-click on background & choose 'Refresh'.
'***************************************************************
On Error Resume Next
Dim oOL As Outlook.Application
Dim oSelection As Outlook.Selection
Set oOL = New Outlook.Application
Set oSelection = oOL.ActiveExplorer.Selection
Set objShell = CreateObject("WScript.Shell" )
vTempInt = objShell.RegRead("HKCU\software\microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Cache" )
' альтернативно можно и напрямую прописать
'vTempInt = "C:\Documents and Settings\<User>\Local Settings\Temporary Internet Files"
vPath = vTempInt & "\"
vHTMLBody = "<HTML><title>View Email Attachments</title>" _
& "<body bgcolor=#888888><font face=Arial size=3 color=#FFFFFF>"
vEmailNum = 0
For Each obj In oSelection
vEmailNum = vEmailNum + 10
vSubject = "Attachments from: <b>" _
& obj.Subject & "</b><br>"
vHTMLBody = vHTMLBody & vSubject
vAttachNum = vEmailNum
For Each Attachment In obj.Attachments
vAttachNum = vAttachNum + 1
vImg = "document.img" & vAttachNum
vWidth = "document.body.clientWidth - 20"
Attachment.SaveAsFile (vPath & Attachment.FileName)
vHTMLBody = vHTMLBody _
& "<b>" & Attachment.FileName & "</b><br>" _
& "<a href=""javascript:fWidth(" & vImg & " );"">" _
& "<center><IMG name=""img" & vAttachNum & """ alt="""" hspace=0 " _
& "src=""" & vPath & Attachment.FileName & """ align=baseline " _
& "border=0 " & "onload=""vOrig=String(" & vImg & ".width)" _
& "+ ' x ' + String(" & vImg & ".height);vRatio=(" & vWidth _
& " )/" & vImg & ".width;" & vImg & ".alt='Original Size: ' + " _
& "vOrig + '\n Scaled Size: ';if(" & vImg & ".width <=" _
& vWidth & " ){" & vImg & ".alt=" & vImg & ".alt + vOrig;}" _
& "else{" & vImg & ".alt=" & vImg & ".alt + String(" & vWidth _
& " )+ ' x ' + String(Math.round(vRatio *" & vImg & ".height));}" _
& "if (" & vImg & ".width >" & vWidth & " ){" & vImg & ".width = " _
& vWidth & ";}""></center></a><br><br><br>"
Next
vHTMLBody = vHTMLBody & "</a><br><br>"
Next
If Not vImg = "" Then
vHTMLBody = vHTMLBody & "<script>function fWidth (vImg){" _
& "vCRLF=vImg.alt.indexOf('\n' );vOrgWidth=vImg.alt.substring" _
& "(vImg.alt.indexOf(':' )+2, vImg.alt.indexOf('x' )-1);" _
& "vRatio=vOrgWidth/vImg.width;if(vImg.width == " & vWidth _
& "|| vOrgWidth <= " & vWidth & " ){vImg.width=vOrgWidth;" _
& "vImg.alt=vImg.alt.substring(0,vCRLF) + '\n Scaled Size: '" _
& "+ vImg.alt.substring(vImg.alt.indexOf(':' )+2,vCRLF);}else" _
& "{vImg.width=" & vWidth & ";vImg.alt=vImg.alt.substring(0,vCRLF)" _
& "+ '\n Scaled Size: ' + String(" & vWidth & " )+ ' x ' + " _
& "String(Math.round(vRatio * vImg.height));}}</script>"
End If
vHTMLBody = vHTMLBody & "</font></body></html>"
' Set ie = CreateObject("internetexplorer.application" )
Dim ie As New InternetExplorer
With ie.Application
.toolbar = 0
.menubar = 0
.statusbar = 0
.Left = 100
.Top = 100
.Height = 600
.Width = 800
.navigate "about:blank"
.document.Open
.document.Write vHTMLBody
.document.Close
.Visible = True
End With
ie.Visible = True
vTimer = 0
Do Until ie.readyState = 4 Or vTimer = 10000
Sleep 10
vTimer = vTimer + 10
Loop
Set ie = Nothing
Set objShell = Nothing
Set oSelection = Nothing
Set oOL = Nothing
End Sub
Новости
Чаты
88:88 
