Attribute VB_Name = "AttachmentEditFix"
Public Sub OpenExcelAttach()
	Dim objOL As Outlook.Application
	Dim objMsg As Outlook.MailItem 'Object
	Dim objAttachments As Outlook.Attachments
	Dim objSelection As Outlook.Selection
	Dim i As Long
	Dim lngCount As Long
	Dim strFile As String
	Dim strFolderpath As String
	Dim strDeletedFiles As String

	'Get the path to your My Documents folder
	strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
	On Error Resume Next

	'Instantiate an Outlook Application object.
	Set objOL = CreateObject("Outlook.Application")

	'Get the collection of selected objects.
	Set objSelection = objOL.ActiveExplorer.Selection

	'Set the Attachment folder.
	strFolderpath = strFolderpath & "\OLAttachments\"

	'Use the MsgBox command to troubleshoot. Remove it from the final code.
	'MsgBox strFolderpath

	'Check each selected item for attachments. If attachments exist,
	'save them to the Temp folder and strip them from the item.
	For Each objMsg In objSelection
		'This code only strips attachments from mail items.
		'If objMsg.class=olMail Then
		'Get the Attachments collection of the item.
		Set objAttachments = objMsg.Attachments
		lngCount = objAttachments.Count

		'Use the MsgBox command to troubleshoot. Remove it from the final code.
		'MsgBox objAttachments.Count

		If lngCount > 0 Then
			'We need to use a count down loop for removing items
			'from a collection. Otherwise, the loop counter gets
			'confused and only every other item is removed.

			For i = lngCount To 1 Step -1
				'Save attachment before deleting from item.
				'Get the file name.
				strFile = objAttachments.Item(i).FileName

				'Combine with the path to the Temp folder.

				'Save the attachment as a file.

				Set oWSH = CreateObject("WScript.Shell")
				soutsectmp = oWSH.RegRead("HKCU\Software\Microsoft\Office\14.0" _
					& "\Outlook\Security\OutlookSecureTempFolder")
				Dim fullpath As String
				Dim temp As String
				temp = "c:\tempsave\" & strFile
				fullpath = soutsectmp & strFile
				objAttachments.Item(i).SaveAsFile temp
				Dim oExcel As Excel.Application
				Dim oWB As Workbook
				Set oExcel = New Excel.Application
				Set oWB = oExcel.Workbooks.Open(temp)
				oExcel.Visible = True

				'Delete the attachment.
				'objAttachments.Item(i).Delete

				'write the save as path to a string to add to the message
				'check for html and use html tags in link
				'If objMsg.BodyFormat <> olFormatHTML Then
				'	strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
				'Else
				'	strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
				'		strFile & "'>" & strFile & "</a>"
				'End If

				'Use the MsgBox command to troubleshoot. Remove it from the final code.
				'MsgBox strDeletedFiles
			Next i
		End If

		'Adds the filename string to the message body and save it
		'Check for HTML body
		'If objMsg.BodyFormat <> olFormatHTML Then
		'	objMsg.Body = objMsg.Body & vbCrLf & _
		'		"The file(s) were saved to " & strDeletedFiles
		'Else
		'	objMsg.HTMLBody = objMsg.HTMLBody & "<p>" & _
		'		"The file(s) were saved to " & strDeletedFiles & "</p>"
		'End If
		'objMsg.Save
	Next

ExitSub:

	Set objAttachments = Nothing
	Set objMsg = Nothing
	Set objSelection = Nothing
	Set objOL = Nothing
End Sub

Public Sub SaveExcelAttach()
	Dim objOL As Outlook.Application
	Dim objMsg As Outlook.MailItem 'Object
	Dim objAttachments As Outlook.Attachments
	Dim objSelection As Outlook.Selection
	Dim i As Long
	Dim lngCount As Long
	Dim strFile As String
	Dim strFolderpath As String
	Dim strDeletedFiles As String

	' Get the path to your My Documents folder
	strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
	On Error Resume Next

	' Instantiate an Outlook Application object.
	Set objOL = CreateObject("Outlook.Application")

	' Get the collection of selected objects.
	Set objSelection = objOL.ActiveExplorer.Selection

	' Set the Attachment folder.
	strFolderpath = strFolderpath & "\OLAttachments\"

	'Use the MsgBox command to troubleshoot. Remove it from the final code.
	'MsgBox strFolderpath

	' Check each selected item for attachments. If attachments exist,
	' save them to the Temp folder and strip them from the item.
	For Each objMsg In objSelection

		' This code only strips attachments from mail items.
		' If objMsg.class=olMail Then
		' Get the Attachments collection of the item.
		Set objAttachments = objMsg.Attachments
		lngCount = objAttachments.Count

		'Use the MsgBox command to troubleshoot. Remove it from the final code.
		' MsgBox objAttachments.Count

		If lngCount > 0 Then

			' We need to use a count down loop for removing items
			' from a collection. Otherwise, the loop counter gets
			' confused and only every other item is removed.

			For i = lngCount To 1 Step -1

				' Save attachment before deleting from item.
				' Get the file name.
				strFile = objAttachments.Item(i).FileName

				' Combine with the path to the Temp folder.

				' Save the attachment as a file.

				Set oWSH = CreateObject("WScript.Shell")
				soutsectmp = oWSH.RegRead("HKCU\Software\Microsoft\Office\14.0" _
					& "\Outlook\Security\OutlookSecureTempFolder")
				Dim fullpath As String
				Dim temp As String
				temp = "c:\tempsave\" & strFile
				fullpath = soutsectmp & strFile
				Dim KillFile  As String
				KillFile = fullpath
				'Check that file exists
				If Len(Dir$(KillFile)) > 0 Then
					'First remove readonly attribute, if set
					SetAttr KillFile, vbNormal
					'Then delete the file
					 Kill KillFile
				End If
				'objAttachments.Item(i).SaveAsFile fullpath
				Application.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT

				'SAVES FILE USING THE VARIABLE BOOKNAME AS FILENAME
				ActiveWorkbook.SaveAs FileName:=fullpath

				Application.DisplayAlerts = True
				SetAttr fullpath, vbReadOnly

				'Delete the attachment.
				'objAttachments.Item(i).Delete

				'write the save as path to a string to add to the message
				'check for html and use html tags in link
				'If objMsg.BodyFormat <> olFormatHTML Then
				'	strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
				'Else
				'	strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
				'		strFile & "'>" & strFile & "</a>"
				'End If

				'Use the MsgBox command to troubleshoot. Remove it from the final code.
				'MsgBox strDeletedFiles
			Next i
		End If

		'Adds the filename string to the message body and save it
		'Check for HTML body
		'If objMsg.BodyFormat <> olFormatHTML Then
		'	objMsg.Body = objMsg.Body & vbCrLf & _
		'		"The file(s) were saved to " & strDeletedFiles
		'Else
		'	objMsg.HTMLBody = objMsg.HTMLBody & "<p>" & _
		'		"The file(s) were saved to " & strDeletedFiles & "</p>"
		'End If
		'objMsg.Save
	Next

ExitSub:
	Set objAttachments = Nothing
	Set objMsg = Nothing
	Set objSelection = Nothing
	Set objOL = Nothing
End Sub

Public Sub OpenWordAttach()
	Dim objOL As Outlook.Application
	Dim objMsg As Outlook.MailItem 'Object
	Dim objAttachments As Outlook.Attachments
	Dim objSelection As Outlook.Selection
	Dim i As Long
	Dim lngCount As Long
	Dim strFile As String
	Dim strFolderpath As String
	Dim strDeletedFiles As String

	'Get the path to your My Documents folder
	strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
	On Error Resume Next

	'Instantiate an Outlook Application object.
	Set objOL = CreateObject("Outlook.Application")

	'Get the collection of selected objects.
	Set objSelection = objOL.ActiveExplorer.Selection

	'Set the Attachment folder.
	strFolderpath = strFolderpath & "\OLAttachments\"

	'Use the MsgBox command to troubleshoot. Remove it from the final code.
	'MsgBox strFolderpath

	'Check each selected item for attachments. If attachments exist,
	'save them to the Temp folder and strip them from the item.
	For Each objMsg In objSelection
		'This code only strips attachments from mail items.
		'If objMsg.class=olMail Then
		'Get the Attachments collection of the item.
		Set objAttachments = objMsg.Attachments
		lngCount = objAttachments.Count

		'Use the MsgBox command to troubleshoot. Remove it from the final code.
		'MsgBox objAttachments.Count

		If lngCount > 0 Then
			'We need to use a count down loop for removing items
			'from a collection. Otherwise, the loop counter gets
			'confused and only every other item is removed.

			For i = lngCount To 1 Step -1
				'Save attachment before deleting from item.
				'Get the file name.
				strFile = objAttachments.Item(i).FileName

				'Combine with the path to the Temp folder.

				'Save the attachment as a file.

				Set oWSH = CreateObject("WScript.Shell")
				soutsectmp = oWSH.RegRead("HKCU\Software\Microsoft\Office\14.0" _
					& "\Outlook\Security\OutlookSecureTempFolder")
				Dim fullpath As String
				Dim temp As String
				temp = "c:\tempsave\" & strFile
				fullpath = soutsectmp & strFile

				objAttachments.Item(i).SaveAsFile temp
				Dim oword As Word.Application

				Dim oWB As Documents
				Set oword = New Word.Application
				Set oWB = oword.Documents.Open(fullpath)
				oword.Visible = True


				'Delete the attachment.
				'objAttachments.Item(i).Delete

				'write the save as path to a string to add to the message
				'check for html and use html tags in link
				'If objMsg.BodyFormat <> olFormatHTML Then
				'	strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
				'Else
				'	strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
				'		strFile & "'>" & strFile & "</a>"
				'End If

				'Use the MsgBox command to troubleshoot. Remove it from the final code.
				'MsgBox strDeletedFiles
			Next i
		End If

		'Adds the filename string to the message body and save it
		'Check for HTML body
		'If objMsg.BodyFormat <> olFormatHTML Then
		'	objMsg.Body = objMsg.Body & vbCrLf & _
		'		"The file(s) were saved to " & strDeletedFiles
		'Else
		'	objMsg.HTMLBody = objMsg.HTMLBody & "<p>" & _
		'		"The file(s) were saved to " & strDeletedFiles & "</p>"
		'End If
		'objMsg.Save

	Next

ExitSub:
	Set objAttachments = Nothing
	Set objMsg = Nothing
	Set objSelection = Nothing
	Set objOL = Nothing
End Sub

Public Sub SaveWordAttach()
	Dim objOL As Outlook.Application
	Dim objMsg As Outlook.MailItem 'Object
	Dim objAttachments As Outlook.Attachments
	Dim objSelection As Outlook.Selection
	Dim i As Long
	Dim lngCount As Long
	Dim strFile As String
	Dim strFolderpath As String
	Dim strDeletedFiles As String

	'Get the path to your My Documents folder
	strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
	On Error Resume Next

	'Instantiate an Outlook Application object.
	Set objOL = CreateObject("Outlook.Application")

	'Get the collection of selected objects.
	Set objSelection = objOL.ActiveExplorer.Selection

	'Set the Attachment folder.
	strFolderpath = strFolderpath & "\OLAttachments\"

	'Use the MsgBox command to troubleshoot. Remove it from the final code.
	'MsgBox strFolderpath

	'Check each selected item for attachments. If attachments exist,
	'save them to the Temp folder and strip them from the item.
	For Each objMsg In objSelection
		'This code only strips attachments from mail items.
		'If objMsg.class=olMail Then
		'Get the Attachments collection of the item.
		Set objAttachments = objMsg.Attachments
		lngCount = objAttachments.Count

		'Use the MsgBox command to troubleshoot. Remove it from the final code.
		'MsgBox objAttachments.Count

		If lngCount > 0 Then
			'We need to use a count down loop for removing items
			'from a collection. Otherwise, the loop counter gets
			'confused and only every other item is removed.

			For i = lngCount To 1 Step -1
				'Save attachment before deleting from item.
				'Get the file name.
				strFile = objAttachments.Item(i).FileName

				'Combine with the path to the Temp folder.

				'Save the attachment as a file.

				Set oWSH = CreateObject("WScript.Shell")
				soutsectmp = oWSH.RegRead("HKCU\Software\Microsoft\Office\14.0" _
					& "\Outlook\Security\OutlookSecureTempFolder")
				Dim fullpath As String
				Dim temp As String
				temp = "c:\tempsave\" & strFile
				fullpath = soutsectmp & strFile
				Dim KillFile  As String
				KillFile = fullpath
				'Check that file exists
				If Len(Dir$(KillFile)) > 0 Then
					'First remove readonly attribute, if set
					SetAttr KillFile, vbNormal
					'Then delete the file
					Kill KillFile
				End If
				'objAttachments.Item(i).SaveAsFile fullpath
				Application.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT

				'SAVES FILE USING THE VARIABLE BOOKNAME AS FILENAME
				ActiveDocument.SaveAs FileName:=fullpath

				Application.DisplayAlerts = True
				SetAttr fullpath, vbReadOnly

				'Delete the attachment.
				'objAttachments.Item(i).Delete

				'write the save as path to a string to add to the message
				'check for html and use html tags in link
				'If objMsg.BodyFormat <> olFormatHTML Then
				'	strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
				'Else
				'	strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
				'		strFile & "'>" & strFile & "</a>"
				'End If

				'Use the MsgBox command to troubleshoot. Remove it from the final code.
				'MsgBox strDeletedFiles
			Next i
		End If

		'Adds the filename string to the message body and save it
		'Check for HTML body
		'If objMsg.BodyFormat <> olFormatHTML Then
		'	objMsg.Body = objMsg.Body & vbCrLf & _
		'		"The file(s) were saved to " & strDeletedFiles
		'Else
		'	objMsg.HTMLBody = objMsg.HTMLBody & "<p>" & _
		'		"The file(s) were saved to " & strDeletedFiles & "</p>"
		'End If
		'objMsg.Save
	Next

ExitSub:
	Set objAttachments = Nothing
	Set objMsg = Nothing
	Set objSelection = Nothing
	Set objOL = Nothing
End Sub