What do I need to add to the code below to get an Excel doc attached to the email about to be sent? (About two thirds the way down the page see red text). TIA.
Sub ParseEPDMRequest(Item As Outlook.MailItem)
'parses inbound email using Regular Expression tools and returns required number of specified file numbers
Dim Reg1 As RegExp
Dim M1 As MatchCollection
Dim M As Match
Dim strSubject As String
Dim testSubject As String
Dim objType As String
Dim itemCount As Integer
Dim myAttachments As Outlook.Attachments
TheRequest = ""
DwgCount = 0
PrtCount = 0
AsmCount = 0
PrtNumbers = ""
AsmNumbers = ""
DwgNumbers = ""
addressee = ""
KillFile = "c:\temp\EPDM Numbers.xlsx"
Set Reg1 = New RegExp
' \s* = invisible spaces
' \d* = match digits
' \w* = match alphanumeric
For i = 1 To 3
With Reg1
Select Case i
Case 1
.Pattern = "Drawings\s*[:]+\s*(\w*)\s*"
.Global = False
objType = "Drawing"
Case 2
.Pattern = "Parts\s*[:]+\s*(\w*)\s*"
.Global = False
objType = "Part"
Case 3
.Pattern = "Assemblies\s*[:]+\s*(\w*)\s*"
.Global = False
objType = "Assembly"
End Select
End With
If Reg1.Test(Item.Body) Then
Set M1 = Reg1.Execute(Item.Body)
For Each M In M1
strSubject = M.SubMatches(0)
itemCount = strSubject
TheRequest = vbCrLf & objType & ": " & strSubject & TheRequest
'Debug.Print ObjType & ": " & strSubject
'Debug.Print TheRequest
If objType = "Assembly" Then AsmCount = strSubject
If objType = "Part" Then PrtCount = strSubject
If objType = "Drawing" Then DwgCount = strSubject
strSubject = ""
Next
End If
If itemCount <> 0 Then
theResult = ConnectSqlServer(objType, itemCount)
itemCount = 0
End If
If objType = "Assembly" Then AsmNumbers = theResult
If objType = "Part" Then PrtNumbers = theResult
If objType = "Drawing" Then DwgNumbers = theResult
theResult = ""
Next i
theAddress = GetSmtpAddress(Item)
Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)
With objMsg
.To = theAddress
.subject = "Here are your EPDM numbers"
.BodyFormat = olFormatPlain ' send plain text message
.Body = "You requested the following EPDM numbers:" & vbCrLf & vbCrLf _
& PrtCount & " Parts" & vbCrLf & vbCrLf _
& AsmCount & " Assemblies" & vbCrLf & vbCrLf _
& DwgCount & " Drawings" & vbCrLf & vbCrLf & vbCrLf _
& "Here are the Part numbers you have been assigned:" & vbCrLf _
& PrtNumbers & vbCrLf & vbCrLf _
& "Here are the Assembly numbers you have been assigned:" & vbCrLf _
& AsmNumbers & vbCrLf & vbCrLf _
& "Here are the Drawing numbers you have been assigned:" & vbCrLf _
& DwgNumbers & vbCrLf & vbCrLf _
& "Please copy and paste for accuracy." & vbCrLf & vbCrLf _
& "Regards," & vbCrLf & vbCrLf _
& "Your EPDM Service Agent." & vbCrLf & vbCrLf _
& "This is an automated system do not reply to this address."
.Send
End With
End Sub
Sub ParseEPDMRequest(Item As Outlook.MailItem)
'parses inbound email using Regular Expression tools and returns required number of specified file numbers
Dim Reg1 As RegExp
Dim M1 As MatchCollection
Dim M As Match
Dim strSubject As String
Dim testSubject As String
Dim objType As String
Dim itemCount As Integer
Dim myAttachments As Outlook.Attachments
TheRequest = ""
DwgCount = 0
PrtCount = 0
AsmCount = 0
PrtNumbers = ""
AsmNumbers = ""
DwgNumbers = ""
addressee = ""
KillFile = "c:\temp\EPDM Numbers.xlsx"
Set Reg1 = New RegExp
' \s* = invisible spaces
' \d* = match digits
' \w* = match alphanumeric
For i = 1 To 3
With Reg1
Select Case i
Case 1
.Pattern = "Drawings\s*[:]+\s*(\w*)\s*"
.Global = False
objType = "Drawing"
Case 2
.Pattern = "Parts\s*[:]+\s*(\w*)\s*"
.Global = False
objType = "Part"
Case 3
.Pattern = "Assemblies\s*[:]+\s*(\w*)\s*"
.Global = False
objType = "Assembly"
End Select
End With
If Reg1.Test(Item.Body) Then
Set M1 = Reg1.Execute(Item.Body)
For Each M In M1
strSubject = M.SubMatches(0)
itemCount = strSubject
TheRequest = vbCrLf & objType & ": " & strSubject & TheRequest
'Debug.Print ObjType & ": " & strSubject
'Debug.Print TheRequest
If objType = "Assembly" Then AsmCount = strSubject
If objType = "Part" Then PrtCount = strSubject
If objType = "Drawing" Then DwgCount = strSubject
strSubject = ""
Next
End If
If itemCount <> 0 Then
theResult = ConnectSqlServer(objType, itemCount)
itemCount = 0
End If
If objType = "Assembly" Then AsmNumbers = theResult
If objType = "Part" Then PrtNumbers = theResult
If objType = "Drawing" Then DwgNumbers = theResult
theResult = ""
Next i
theAddress = GetSmtpAddress(Item)
Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)
With objMsg
.To = theAddress
.subject = "Here are your EPDM numbers"
.BodyFormat = olFormatPlain ' send plain text message
.Body = "You requested the following EPDM numbers:" & vbCrLf & vbCrLf _
& PrtCount & " Parts" & vbCrLf & vbCrLf _
& AsmCount & " Assemblies" & vbCrLf & vbCrLf _
& DwgCount & " Drawings" & vbCrLf & vbCrLf & vbCrLf _
& "Here are the Part numbers you have been assigned:" & vbCrLf _
& PrtNumbers & vbCrLf & vbCrLf _
& "Here are the Assembly numbers you have been assigned:" & vbCrLf _
& AsmNumbers & vbCrLf & vbCrLf _
& "Here are the Drawing numbers you have been assigned:" & vbCrLf _
& DwgNumbers & vbCrLf & vbCrLf _
& "Please copy and paste for accuracy." & vbCrLf & vbCrLf _
& "Regards," & vbCrLf & vbCrLf _
& "Your EPDM Service Agent." & vbCrLf & vbCrLf _
& "This is an automated system do not reply to this address."
.Send
End With
End Sub