S
suntex
Hello,
I came across the following macro that will open a new window to display
image attachments for printing or viewing. The new html also displays the
subject line from the email the attachments are from.
I need some help editing this so that it will also add the text from the
email message along with everything else. Can someone please help with this?
I think this macro would be a huge help to a lot of people if we could get
this working right.
The macro is....
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub view_attachments()
'***************************************************************
' ver. 1/30/04
' - Select one or multiple emails.
' - Copies files to 'Temporary Internet Files\view_attachments'
' (previously copied files are deleted each time it's run).
' - Only image files are displayed (no others are executed).
' - Right-click images to 'Save As', 'Email', 'Print', 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")
Set fs = CreateObject("Scripting.FileSystemObject")
vTempInt = objShell.RegRead("HKCU\software\microsoft\" _
& "Windows\CurrentVersion\Explorer\Shell Folders\Cache")
vPath = vTempInt & "\view_attachments\"
If fs.FolderExists(vPath) Then
fs.DeleteFile (vPath & "*.*")
Else
fs.CreateFolder vPath
End If
vBkgrColor = "000000"
vFontColor = "FFFFFF"
vHTMLBody = "<HTML><title>View Email Attachments</title>" _
& "<body bgcolor=#" & vBkgrColor & " link=#" & vFontColor _
& " alink=#" & vFontColor & " vlink=#" & vFontColor _
& "><font face=Arial size=3 color=#" & vFontColor & ">"
vEmailNum = 0
For Each obj In oSelection
vEmailNum = vEmailNum + 10
vSubject = "Attachments from: <a href=""Outlook:" _
& obj.EntryID & """><b>" & obj.Subject & "</b></a><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);" _
& "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(vImg.height);}}</script>"
End If
vHTMLBody = vHTMLBody & "</font></body></html>"
Set ie = CreateObject("internetexplorer.application")
With ie
.toolbar = 0
.menubar = 0
.statusbar = 0
.Left = 100
.Top = 50
.Height = 600
.Width = 800
.navigate "about:blank"
.document.Open
.document.Write vHTMLBody
.document.Close
.Visible = True
End With
vTimer = 0
Do Until ie.readyState = 4 Or vTimer = 10000
Sleep 10
vTimer = vTimer + 10
Loop
Set ie = Nothing
Set fs = Nothing
Set objShell = Nothing
Set oSelection = Nothing
Set oOL = Nothing
End Sub
Thanks for any and all help.
I came across the following macro that will open a new window to display
image attachments for printing or viewing. The new html also displays the
subject line from the email the attachments are from.
I need some help editing this so that it will also add the text from the
email message along with everything else. Can someone please help with this?
I think this macro would be a huge help to a lot of people if we could get
this working right.
The macro is....
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub view_attachments()
'***************************************************************
' ver. 1/30/04
' - Select one or multiple emails.
' - Copies files to 'Temporary Internet Files\view_attachments'
' (previously copied files are deleted each time it's run).
' - Only image files are displayed (no others are executed).
' - Right-click images to 'Save As', 'Email', 'Print', 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")
Set fs = CreateObject("Scripting.FileSystemObject")
vTempInt = objShell.RegRead("HKCU\software\microsoft\" _
& "Windows\CurrentVersion\Explorer\Shell Folders\Cache")
vPath = vTempInt & "\view_attachments\"
If fs.FolderExists(vPath) Then
fs.DeleteFile (vPath & "*.*")
Else
fs.CreateFolder vPath
End If
vBkgrColor = "000000"
vFontColor = "FFFFFF"
vHTMLBody = "<HTML><title>View Email Attachments</title>" _
& "<body bgcolor=#" & vBkgrColor & " link=#" & vFontColor _
& " alink=#" & vFontColor & " vlink=#" & vFontColor _
& "><font face=Arial size=3 color=#" & vFontColor & ">"
vEmailNum = 0
For Each obj In oSelection
vEmailNum = vEmailNum + 10
vSubject = "Attachments from: <a href=""Outlook:" _
& obj.EntryID & """><b>" & obj.Subject & "</b></a><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);" _
& "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(vImg.height);}}</script>"
End If
vHTMLBody = vHTMLBody & "</font></body></html>"
Set ie = CreateObject("internetexplorer.application")
With ie
.toolbar = 0
.menubar = 0
.statusbar = 0
.Left = 100
.Top = 50
.Height = 600
.Width = 800
.navigate "about:blank"
.document.Open
.document.Write vHTMLBody
.document.Close
.Visible = True
End With
vTimer = 0
Do Until ie.readyState = 4 Or vTimer = 10000
Sleep 10
vTimer = vTimer + 10
Loop
Set ie = Nothing
Set fs = Nothing
Set objShell = Nothing
Set oSelection = Nothing
Set oOL = Nothing
End Sub
Thanks for any and all help.