Remove attachments like image001.png (typically from sugnatures)

[bmdo]

Hi,

found this code - and just pasted it to my existing code (at the bottom)
But it does not work.... :crying: How can I combine these 2 :)
Sorry, I am still a newbie



Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)


'if attachments are there
If Item.Attachments.Count > 0 Then

'for all attachments
For i = Item.Attachments.Count To 1 Step -1

'if the attachment's filename is similar to "image###.png", remove
If InStr(Item.Attachments(i).FileName, "image") > 0 And Right(Item.Attachments(i).FileName, 4) = ".png" Then
Item.Attachments.Remove (i)
End If

Next
End If
End Sub


My existing code



Option Explicit

Private oReceivedMail As Outlook.MailItem
Private oNewMail As Outlook.MailItem
Private isShowing As Boolean

Public Function isReadyToRun() As Integer
Dim oFSO As Object
Dim sRes As Integer

isReadyToRun = Error.doNoError

sRes = Settings.isReadyToRun
If sRes = Error.doNoError Then
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.fileExists(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO1") + ".html") And _
oFSO.fileExists(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO2") + ".html") And _
oFSO.fileExists(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO3") + ".html") And _
oFSO.fileExists(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO4") + ".html") And _
oFSO.fileExists(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO5") + ".html") Then
isReadyToRun = Error.doFileDoesNotExist
Else
If isShowing Then isReadyToRun = Error.doFormAlreadyShowing
End If
Else
isReadyToRun = sRes
End If

Set oFSO = Nothing
End Function

Public Sub Startup()
isShowing = False
End Sub

Public Sub Shutdown()
Set oReceivedMail = Nothing
Set oNewMail = Nothing
End Sub

Public Sub Sync()
Dim oFSO As Object

Set oFSO = CreateObject("Scripting.FileSystemObject")

If doPing = 0 Then
If oFSO.fileExists(Settings.GetSettingValue("PurchaseOrder", "LiveTemplatePath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO1") + ".html") Then
' We have access to live template file

If oFSO.fileExists(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO1") + ".html") Then
' remember to delete current cached template before anything else
Call oFSO.DeleteFile(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO1") + ".html")
End If

Call oFSO.CopyFile(Settings.GetSettingValue("PurchaseOrder", "LiveTemplatePath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO1") + ".html", Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO1") + ".html", True)
End If

If oFSO.fileExists(Settings.GetSettingValue("PurchaseOrder", "LiveTemplatePath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO2") + ".html") Then
' We have access to live template file

If oFSO.fileExists(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO2") + ".html") Then
' remember to delete current cached template before anything else
Call oFSO.DeleteFile(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO2") + ".html")
End If

Call oFSO.CopyFile(Settings.GetSettingValue("PurchaseOrder", "LiveTemplatePath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO2") + ".html", Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO2") + ".html", True)
End If

If oFSO.fileExists(Settings.GetSettingValue("PurchaseOrder", "LiveTemplatePath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO3") + ".html") Then
' We have access to live template file

If oFSO.fileExists(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO3") + ".html") Then
' remember to delete current cached template before anything else
Call oFSO.DeleteFile(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO3") + ".html")
End If

Call oFSO.CopyFile(Settings.GetSettingValue("PurchaseOrder", "LiveTemplatePath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO3") + ".html", Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO3") + ".html", True)
End If

If oFSO.fileExists(Settings.GetSettingValue("PurchaseOrder", "LiveTemplatePath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO4") + ".html") Then
' We have access to live template file

If oFSO.fileExists(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO4") + ".html") Then
' remember to delete current cached template before anything else
Call oFSO.DeleteFile(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO4") + ".html")
End If

Call oFSO.CopyFile(Settings.GetSettingValue("PurchaseOrder", "LiveTemplatePath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO4") + ".html", Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO4") + ".html", True)
End If

If oFSO.fileExists(Settings.GetSettingValue("PurchaseOrder", "LiveTemplatePath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO5") + ".html") Then
' We have access to live template file

If oFSO.fileExists(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO5") + ".html") Then
' remember to delete current cached template before anything else
Call oFSO.DeleteFile(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO5") + ".html")
End If

Call oFSO.CopyFile(Settings.GetSettingValue("PurchaseOrder", "LiveTemplatePath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO5") + ".html", Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO5") + ".html", True)
End If
End If
Set oFSO = Nothing
End Sub

Private Sub cmdCancel_Click()
Me.Hide
isShowing = False
If Not oNewMail Is Nothing Then
oNewMail.Delete
End If
Set oReceivedMail = Nothing

End Sub

Private Sub cmdSubmit_Click()

Dim oFSO As Scripting.FileSystemObject
Dim oFS As Scripting.TextStream
Dim sTmp, sOrderRef, sText, sTemplate, sTmpSubject As String
Dim i As Integer


If doPing = 0 Then
' ping and then go go go


oNewMail.Subject = Replace(oNewMail.Subject, "RE: ", "", , , vbTextCompare)
oNewMail.Subject = Replace(oNewMail.Subject, "FW: ", "", , , vbTextCompare)

sTmpSubject = oNewMail.Subject
If txtOrderRef.Value = True Then

'sTmpSubject = "Danoffice" + " " + "ref" + " " + txtOrderRef.Value + " - " + sTmpSubject
sTmpSubject = sTmpSubject + " " + "Danoffice" + " " + "ref" + " " + txtOrderRef.Value

End If
oNewMail.Subject = sTmpSubject


' choose template file

If Me.rbPO1 = True Then sTemplate = Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO1")
If Me.rbPO2 = True Then sTemplate = Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO2")
If Me.rbPO3 = True Then sTemplate = Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO3")
If Me.rbPO4 = True Then sTemplate = Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO4")
If Me.rbPO5 = True Then sTemplate = Settings.GetSettingValue("PurchaseOrder", "TemplateFilePO5")


oNewMail.To = oReceivedMail.SenderEmailAddress

' if cbCheckMark.value then
' Kigger KUN på recipients in i receivedmail og ikke sender.
For i = 1 To oReceivedMail.Recipients.Count
If InStr(1, oReceivedMail.To, oReceivedMail.Recipients.Item(i).AddressEntry, vbTextCompare) Then oNewMail.To = oNewMail.To + ";" + oReceivedMail.Recipients.Item(i).Address
If InStr(1, oReceivedMail.CC, oReceivedMail.Recipients.Item(i).AddressEntry, vbTextCompare) Then oNewMail.CC = oNewMail.CC + ";" + oReceivedMail.Recipients.Item(i).Address
Next

' Remove @Danoffice.com from To and CC
' HUSK at der SKAL stå " - Danoffice IT" ifm brugeren i AD!!! Ellers virker denne funktion ikke
'Call SharedFunctionality.doRemoveRecipient(oNewMail, "danoffice")
'end if

oNewMail.Recipients.ResolveAll

Set oFSO = CreateObject("Scripting.FileSystemObject")


' Path to document you want to parse
Set oFS = oFSO.OpenTextFile(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + sTemplate + ".html")

'Copy the open document
Do Until oFS.AtEndOfStream
sText = oFS.ReadAll()
Loop

sText = Replace(sText, "<Contact>", txtcontact.Value, , , vbTextCompare)
oNewMail.BodyFormat = olFormatHTML


Call SharedFunctionality.CopyAttachments(oReceivedMail, oNewMail)

oNewMail.Display

' capture signature AFTER the mail has been displayed, otherwise the signature will not have been rendered and will disappear.
oNewMail.HTMLBody = "<body font-size=11pt>" & sText & oNewMail.HTMLBody & oReceivedMail.HTMLBody & "</body>"

' exit gracefully and hide form
Me.Hide

isShowing = False
Else
Call Error.doThrowError("PurchaseOrder", Error.doUnableToPing)
End If


Set oFSO = Nothing
Set oFS = Nothing
Set oNewMail = Nothing
Set oReceivedMail = Nothing


End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

Private Sub UserForm_Activate()

Dim oCurrentItem As Outlook.MailItem
Dim isThisAForward As Boolean

Set oCurrentItem = SharedFunctionality.doGetCurrentMailItem


If Not oCurrentItem Is Nothing Then

Set oReceivedMail = oCurrentItem

Set oNewMail = oReceivedMail.Reply

End If

With Me
.rbPO1.Value = False
.rbPO2.Value = False
.rbPO3.Value = False
.rbPO4.Value = False
.rbPO5.Value = False
.txtcontact.Value = ""
.txtOrderRef.Value = ""
End With

isShowing = True
Set oCurrentItem = Nothing

Me.txtcontact.SetFocus


End Sub

[skatonni]

Application_ItemSend code goes in ThisOutlookSession

[bmdo]

Application_ItemSend code goes in ThisOutlookSession

Ok, so can I copy the ItemSend code to This Outlook session - and call it from my macro?
Or how is this done?:yes

[gmayor]

You could shorten the line
If InStr(Item.Attachments(i).FileName, "image") > 0 And Right(Item.Attachments(i).FileName, 4) = ".png" Thento
IF Item.Attachments(i).FileName Like "image*.*" Then
Just move the code to the ThisOutlookSession module and it runs automatically whenever you send a message. You don't have to call it.

[bmdo]

I will try - thanks :)