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