I can read code, and adjust code a bit.
I've got access to a company email (say invoice@rr.com).
I want code which looks through all new mail in the inbox of invoice@rr.com (best if this works even when Outlook is not open, but a manually clicked macro would make me happy) and reply to all (with attachment) when:
- there is more then one attachment (exception is one .xml and one .pdf file)
- the attachment is not .pdf, .xml or .icf
- when there is no attachment at all
- when the title has the word "reminder"
- when the message has the word "reminder"
Besides that, the code needs to move the mail to a subfolder called "send back".
I've been reading forums and one of the problems is a picture in a signature also counts as an attachment.
First try after help from Tony:
Sub reply()
'still need to get rid of all the stuff i dont use below (up to the *) but still not sure about the code so I left it here for now
Dim olInspector As Outlook.Inspector
Dim olDocument As Outlook.DocumentItem
Dim olSelection As Outlook.Selection
Dim olReply As MailItem
Dim olAtt As Attachment
Dim olFileType As String
Dim AttachCount As Long
Dim AttachDtl() As String
Dim ExcelWkBk As Excel.Workbook
Dim FileName As String
Dim FolderTgt As MAPIFolder
Dim HtmlBody As String
Dim InterestingItem As Boolean
Dim InxAttach As Long
Dim InxItemCrnt As Long
Dim PathName As String
Dim ReceivedTime As Date
Dim RowCrnt As Long
Dim SenderEmailAddress As String
Dim SenderName As String
Dim Subject As String
Dim TextBody As String
Dim myDestFolder As Outlook.Folder
'*
Set myDestFolder = Session.Folders("Outlook Data File").Folders("replied")
Set Myselect = Outlook.ActiveExplorer.Selection '(i use this in my test to only process selected test mails)
'Set FolderTgt = Session.Folders("invoice@rr.com").Folders("Inbox") ***(this will replace the code above)
For InxItemCrnt = Myselect.Items.Count To 1 Step -1 '(myselect = foldertgt in live)
With Myselect.Items.Item(InxItemCrnt) '(myselect = foldertgt in live)
'still need a workaround for mail with (1 .PDF and 1 .ICF) or (1 .PDF and 1 .XML)
'those combinations are the only combinations when more then one attachment is allowed
'1st filter
If AttachCount = 0 Then 'no attachment = reply
Reply0
.move myDestFolder
Else
'2nd filter
If AttachCount > 1 Then 'more then one attachment = reply
Reply1
.move myDestFolder
Else
'3rd filter
If InStr(Subject, "Reminder") = 0 Then 'reminders need to go to a different mailbox
Reply2
.move myDestFolder
Else
'4th filter
Select Case olFileType
Case ".pdf, .icf, .xml"
If olFileType = LCase$(Right$(olAtt.FileName, 4)) Then
Exit Sub 'if attachment = pdf or ICF then this sub can exit
Else
Reply3 'all mails with incorrect files
.move myDestFolder
End Select
End If
End If
End If
End If
End With
'replies below
Reply0:
Set olReply = Item.Reply '// Reply if no attachment found
olReply.Body = "this is an automatic generated mail." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & ".... insert text...." 'still need to insert some text
olReply.Send
Reply1:
Set olReply = Item.Reply '// Reply more then one attachment
olReply.Body = "this is an automatic generated mail." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & ".... insert text...." 'still need to insert some text
olReply.Send
Reply2:
Set olReply = Item.Reply '// Reply reminders need to go to reminder@rr.com
olReply.Body = "this is an automatic generated mail." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & ".... insert text...." 'still need to insert some text
olReply.Send
Reply3:
Set olReply = Item.Reply '// Reply not correct file
olReply.Body = "this is an automatic generated mail." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & ".... insert text...." 'still need to insert some text
olReply.Send
Next
Set olInspector = Nothing
Set olDocument = Nothing
Set olSelection = Nothing
Set olAtt = Nothing
End Sub
2nd try after some more help from Tony: (note: I'm Dutch so some code has dutch words I'll explain them in English behind the code, it basicly is copy paste from his answer, all credits to Tony)
Sub reply()
Dim Fso As New FileSystemObject
Dim DiagFile As TextStream
Dim FldrInvInbox As MAPIFolder
Dim InxA As Long
Dim InxItemCrnt As Long
Dim NumIcfAttach As Long
Dim NumPdfAttach As Long
Dim NumXmlAttach As Long
Dim NumDocAttach As Long
Dim NumDoxAttach As Long
Dim PathDiag As String
Dim Pos As Long
Dim ProcessThisEmail As Boolean
Dim Subject As String
Dim ReminderInBody As Boolean
Dim ReminderInSubject As Boolean
Dim ReminderInBody1 As Boolean
Dim ReminderInSubject1 As Boolean
Set FldrInvInbox = Session.Folders("invoice@rr.com").Folders("Postvak IN") 'Postvak IN = Inbox)
PathDiag = "z:\VBA test" 'location for diagnostics report
Set DiagFile = Fso.CreateTextFile(PathDiag & "\Diag.txt", True, False)
For InxItemCrnt = FldrInvInbox.Items.Count To 1 Step -1
With FldrInvInbox.Items.Item(InxItemCrnt)
' It is unlikely an Inbox will contain anything but emails
' but it does no harm to check
If .Class = olMail Then
' Extract information that will identify if this email is to be processed
ProcessThisEmail = True ' Assume True until find otherwise
'Below i'm looking for reminder, payment reminder and other similiar text in subject, dutch words are betalingsherinnering and openstaande posten
If InStr(1, LCase(.Subject), "betalingsherinnering") = 0 Then
ReminderInSubject = False
Else
ReminderInSubject = True
ProcessThisEmail = False
End If
If InStr(1, LCase(.Subject), "openstaande posten") = 0 Then
ReminderInSubject1 = False
Else
ReminderInSubject1 = True
ProcessThisEmail = False
End If
'Below i'm looking for reminder, payment reminder and other similiar text in mail, dutch words are betalingsherinnering and openstaande posten
If InStr(1, LCase(.Body), "betalingsherinnering") = 0 Then
ReminderInBody = False
Else
ReminderInBody = True
ProcessThisEmail = False
End If
If InStr(1, LCase(.Body), "openstaande posten") = 0 Then
ReminderInBody1 = False
Else
ReminderInBody1 = True
ProcessThisEmail = False
End If
NumIcfAttach = 0
NumPdfAttach = 0
NumXmlAttach = 0
NumDocAttach = 0
For InxA = 1 To .Attachments.Count
Select Case LCase(Right$(.Attachments(InxA).FileName, "3"))
Case "txt"
NumIcfAttach = NumIcfAttach + 1 'code will be changed soon, need to look at ICF in the name of the attachment
Case "pdf"
NumPdfAttach = NumPdfAttach + 1
Case "doc"
NumDocAttach = NumDocAttach + 1
Case "xml"
NumXmlAttach = NumXmlAttach + 1
End Select
Next InxA
Else ' Not email
ProcessThisEmail = False
End If
End With
' Decide if email is to be processed
If ProcessThisEmail = True Then
If NumXmlAttach > 1 Then
ProcessThisEmail = False
Else
If NumDocAttach <> 0 Then
ProcessThisEmail = False
Else
If NumPdfAttach > 1 Then
ProcessThisEmail = False
Else
If NumIcfAttach > 1 Then
ProcessThisEmail = False
Else
If NumIcfAttach + NumPdfAttach = 2 Then
ProcessThisEmail = True
Else
If NumXmlAttach + NumPdfAttach = 2 Then
ProcessThisEmail = True
Else
If NumXmlAttach = 1 And NumIcfAttach = 0 And NumPdfAttach = 0 And NumDocAttach = 0 Then
ProcessThisEmail = True
Else
If NumPdfAttach = 1 And NumIcfAttach = 0 And NumXmlAttach = 0 And NumDocAttach = 0 Then
ProcessThisEmail = True
Else
If NumIcfAttach = 1 And NumXmlAttach = 0 And NumPdfAttach = 0 And NumDocAttach = 0 Then
ProcessThisEmail = True
Else
If NumXmlAttach + NumPdfAttach + NumIcfAttach = 0 Then
ProcessThisEmail = False
Else
If NumXmlAttach + NumIcfAttach = 2 Then
ProcessThisEmail = False
Else
If NumXmlAttach + NumPdfAttach + NumIcfAttach = 3 Then
ProcessThisEmail = False
Else
If NumIcfAttach + NumPdfAttach <> 2 Then
ProcessThisEmail = False
Else
If NumXmlAttach + NumPdfAttach <> 2 Then
ProcessThisEmail = False
Else
Procisthisemail = False
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
' Output diagnostic information
DiagFile.WriteLine "----- " & InxItemCrnt & " -----"
With FldrInvInbox.Items.Item(InxItemCrnt)
DiagFile.WriteLine "ReceivedTime=" & .ReceivedTime
DiagFile.WriteLine "Sender=" & .Sender
Subject = .Subject
For Pos = Len(Subject) To 1 Step -1
If AscW(Mid(Subject, Pos, 1)) < 1 Or _
AscW(Mid(Subject, Pos, 1)) > 255 Then
Subject = Replace(Subject, Mid(Subject, Pos, 1), "?")
End If
Next
DiagFile.WriteLine "Subject=" & Subject
DiagFile.WriteLine "Reminders: Subject 1=" & ReminderInSubject & _
" Subject 2=" & ReminderInSubject1 & _
" Body 1=" & ReminderInBody & _
" Body 2=" & ReminderInBody1
DiagFile.WriteLine "Attachment counts: ICF=" & NumIcfAttach & _
" PDF=" & NumPdfAttach & " XML=" & NumXmlAttach & _
" Doc=" & NumDocAttach
DiagFile.WriteLine "ProcessThisEmail=" & ProcessThisEmail
End With
' Process email if required
If ProcessThisEmail Then
End If
Next InxItemCrnt
DiagFile.Close
End Sub