Reha,
I am by no means an expert in Outlook, and I put together the following code
mostly by trial and error. There may be a better way to go about this, but I
think the following code will do what you want. It takes the attached Excel
file from a MailItem object, saves it to a temp folder, deletes all the VBA
code from the workbook in the temp folder, deletes the original attachment,
and re-attaches the modified file. The original copy of the file is not
changed, only the attached copy is modified.
The code between the lines marked with '<<<< are most relevant to your
question.
I assume your code has an object variable refering to a running Excel
Application. Subsitute that variable's name where "Excel" appears in the
code (but not in the variable declarations) that follows:
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" ( _
ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Dim OLK As Outlook.Application
Const MAX_PATH = 260&
Sub AAA()
Dim MItem As Outlook.MailItem
Dim Attch As Outlook.Attachment
Dim WB As Excel.Workbook
Dim AttchName As String
Dim TempPath As String
Dim Pos As Integer
Dim PathLen As Long
Dim VBComp As Object
''''''''''''''''''''''''''''''''''''''''''''''''
' Get a reference to a running instance of
' Outlook.
''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
If OLK Is Nothing Then
Set OLK = GetObject(, "Outlook.Application")
End If
If OLK Is Nothing Then
'''''''''''''''''''''''''''''''''''''''''''''''''
' Outlook isn't running. Get out.
''''''''''''''''''''''''''''''''''''''''''''''''
Exit Sub
End If
On Error GoTo 0
''''''''''''''''''''''''''''''''''''''''''''
' Get a temp folder name from Windows
''''''''''''''''''''''''''''''''''''''''''''
TempPath = String$(MAX_PATH, vbNullChar)
PathLen = GetTempPath(MAX_PATH, TempPath)
TempPath = Left$(TempPath, PathLen)
'''''''''''''''''''''''''
' Create a new mail item
' and set the recipient.
'''''''''''''''''''''''''
Set MItem = OLK.CreateItem(olMailItem)
MItem.Recipients.Add "(e-mail address removed)"
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'''''''''''''''''''''''''''''''''''''''''''
' Attach C:\bookone.xls to the mail message.
''''''''''''''''''''''''''''''''''''''''''''
Set Attch = MItem.Attachments.Add("C:\bookone.xls", olByValue)
'''''''''''''''''''''''''''''''''''''''''''''
' Make sure there is no file with the same
' name as the attachment in the temp folder.
'''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Kill TempPath & Attch.Filename
On Error GoTo 0
''''''''''''''''''''''''''''''''''''''''''''''
' store the attachment's file name
' for later use.
'''''''''''''''''''''''''''''''''''''''''''''
AttchName = Attch.Filename
''''''''''''''''''''''''''''''''''''''''''''
' Save the attachment as a file in the temp
' folder.
''''''''''''''''''''''''''''''''''''''''''''
Attch.SaveAsFile TempPath & Attch.Filename
Excel.Application.ScreenUpdating = False
''''''''''''''''''''''''''''''''''''''''''''
' Open the copy of the file that is in the
' temp folder.
''''''''''''''''''''''''''''''''''''''''''''
Set WB = Excel.Workbooks.Open(Filename:=TempPath & Attch.Filename)
'''''''''''''''''''''''''''''''''''''''''''
' delete all VBA code
'''''''''''''''''''''''''''''''''''''''''''
For Each VBComp In WB.VBProject.VBComponents
Select Case VBComp.Type
Case 1, 2, 3
With WB.VBProject.VBComponents
.Remove .Item(VBComp.Name)
End With
Case Else
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next VBComp
'''''''''''''''''''''''''''''''''''''''''''
' Save and close the workbook.
'''''''''''''''''''''''''''''''''''''''''''
WB.Close savechanges:=True
''''''''''''''''''''''''''''''''''''''''''
' Delete the original attachment and attach
' the modified file from the temp folder.
''''''''''''''''''''''''''''''''''''''''''
Attch.Delete
MItem.Attachments.Add Source:=TempPath & AttchName, Type:=olByValue
Excel.Application.ScreenUpdating = True
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
''''''''''''''''''''''''''''''''
' Send the message
'''''''''''''''''''''''''''''''''
MItem.Send
''''''''''''''''''''''''''''''''''''''''''''
' Be a good citizen and clean up your trash.
''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Kill TempPath & Attch.Filename
On Error GoTo 0
End Sub
--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)