Below is the code I am working with.
It works like a charm!! When the email message opens - it does not contain the default email signaute.
Is there a way to call the email message with the signautre?
Thank you in advance!!!
air.
Private Sub Command101_Click()
On Error GoTo Command101_Err
Dim strEmail, strBody As String
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
'**creates an instance of Outlook
Set objOutlook = CreateObject("Outlook.application"
Set objEmail = objOutlook.CreateItem(olMailItem)
'*create string with email address
strEmail = LMPers
strBody = strBody & "ATTN: " & UCase(CStr(Nz(Forms!WWRDataEntry!ATTN, ""
)) & " " & Chr(13) & Chr(13)
strBody = strBody & "Your station has been affected by a World Wide Review of IID " & IID1 & ", " & UCase(CStr(Nz(Forms!WWRDataEntry!FleetType, ""
)) & ", " & UCase(CStr(Nz(Forms!WWRDataEntry!Nomenclature, ""
)) & " , which includes P/N(s) " & UCase(CStr(Nz(Forms!WWRDataEntry!PN, ""
)) & ". The following allocations changes have occured:" & Chr(13) & Chr(13)
strBody = strBody & "***DEALLOCATIONS: " & UCase(CStr(Nz(Forms!WWRDataEntry!GTWY1, ""
)) & " - Due to: " & UCase(CStr(Nz(Forms!WWRDataEntry!DeAllocationReason, ""
)) & " (Please return SV CPW)" & Chr(13) & Chr(13)
strBody = strBody & "***OVERALLOCATIONS: " & UCase(CStr(Nz(Forms!WWRDataEntry!GTWY2, ""
)) & " (Please return SV CPW)" & Chr(13) & Chr(13)
strBody = strBody & "***NEW ALLOCATIONS: " & UCase(CStr(Nz(Forms!WWRDataEntry!GTWY3, ""
)) & " (Please be advised)" & Chr(13) & Chr(13)
strBody = strBody & "***WORLDWIDE ALLOCATIONS: " & UCase(CStr(Nz(Forms!WWRDataEntry!TotalAllocations, ""
)) & " - Backorders will occur until all de-allocated/over-allocated and/or newly purchased units are recieved. Please FWD this to any interested parties." & Chr(13) & Chr(13)
strBody = strBody & "***SUMMARY: This is a " & UCase(CStr(Nz(Forms!WWRDataEntry!Summary, ""
)) & ". The current worldwide allocation investment for IID " & IID1 & " is " & Format([TotalCost], "Currency"
& ". We feel that these changes will provide the most complete coverage by maintaining the best possible utilization of our inventory assest." & Chr(13) & Chr(13)
strBody = strBody & "***CONTACT: Feel free to contact LMP via email address " & LCase(CStr(Nz(Forms!WWRDataEntry!emailcontact, ""
)) & " atlas 5-350-" & ATLAS & " and/or 502-" & PHONE & " with any questions or concerns. Thank you for your cooperation with all material movements." & Chr(13) & Chr(13)
strBody = strBody & "Regards," & Chr(13) & Chr(13)
'***creates email
With objEmail
.TO = strEmail
.Subject = "WWR P/N " & PN & " " & UCase(CStr(Nz(Forms!WWRDataEntry!Nomenclature, ""
)) & ""
.Body = strBody
.Display
End With
Command101_Err:
If Err.Number = 94 Then
Resume Next
End If
Set objEmail = Nothing
Exit Sub
End Sub
It works like a charm!! When the email message opens - it does not contain the default email signaute.
Is there a way to call the email message with the signautre?
Thank you in advance!!!
air.
Private Sub Command101_Click()
On Error GoTo Command101_Err
Dim strEmail, strBody As String
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
'**creates an instance of Outlook
Set objOutlook = CreateObject("Outlook.application"
Set objEmail = objOutlook.CreateItem(olMailItem)
'*create string with email address
strEmail = LMPers
strBody = strBody & "ATTN: " & UCase(CStr(Nz(Forms!WWRDataEntry!ATTN, ""
strBody = strBody & "Your station has been affected by a World Wide Review of IID " & IID1 & ", " & UCase(CStr(Nz(Forms!WWRDataEntry!FleetType, ""
strBody = strBody & "***DEALLOCATIONS: " & UCase(CStr(Nz(Forms!WWRDataEntry!GTWY1, ""
strBody = strBody & "***OVERALLOCATIONS: " & UCase(CStr(Nz(Forms!WWRDataEntry!GTWY2, ""
strBody = strBody & "***NEW ALLOCATIONS: " & UCase(CStr(Nz(Forms!WWRDataEntry!GTWY3, ""
strBody = strBody & "***WORLDWIDE ALLOCATIONS: " & UCase(CStr(Nz(Forms!WWRDataEntry!TotalAllocations, ""
strBody = strBody & "***SUMMARY: This is a " & UCase(CStr(Nz(Forms!WWRDataEntry!Summary, ""
strBody = strBody & "***CONTACT: Feel free to contact LMP via email address " & LCase(CStr(Nz(Forms!WWRDataEntry!emailcontact, ""
strBody = strBody & "Regards," & Chr(13) & Chr(13)
'***creates email
With objEmail
.TO = strEmail
.Subject = "WWR P/N " & PN & " " & UCase(CStr(Nz(Forms!WWRDataEntry!Nomenclature, ""
.Body = strBody
.Display
End With
Command101_Err:
If Err.Number = 94 Then
Resume Next
End If
Set objEmail = Nothing
Exit Sub
End Sub