P
pgarcia
Hello all, I found the following VB code and I was hopeing if someone could
twick it for me?
1. I would like to instead of send out a spread sheet, attache a .txt file
to the message.
2. Pick up the email addressies if they were in colum A (To and B (CC
3. In colum C, pick up the text and put a message the will be in the body of
the email
4. In colum D, pick up the text and put a message in the subject line
5. In colum E & F have a folder path (S:\SUPPORT\CADTAR\CMS\0013) & attache
the "d0013mr.txt" file or if it can pick up file names ending in "mr"
Data (looks better in excel, around 150 lines)
A1 B1 C1 D1
E1 F1
To: CC: Body of message Subject line Path File
(e-mail address removed) (e-mail address removed) Important Monthly Fuel Surcharge Update
BAX Global Update for ARTHREX - 013847514 -
9727 S:\SUPPORT\CADTAR\CMS\9727 d9727ar.txt
VB Code
Option Explicit
Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "C:\Documents and Settings\autpbg1\My
Documents\Attachments"
Const stSubject As String = "MR Fuel update - test maco"
Const vaMsg As Variant = "This is a test, file does not mean anthing." &
vbCrLf & _
"Let me when you get this."
Const vaCopyTo As Variant = "(e-mail address removed)"
Sub Send_Active_Sheet()
Dim stFileName As String
Dim vaRecipients As Variant
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String
'Copy the active sheet to a new temporarily workbook.
With ActiveSheet
.Copy
stFileName = .Range("A1").Value
End With
stAttachment = stPath & "\" & stFileName & ".xls"
'Save and close the temporarily workbook.
With ActiveWorkbook
.SaveAs stAttachment
.Close
End With
'Create the list of recipients.
vaRecipients = VBA.Array("(e-mail address removed)")
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "",
stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.CopyTo = vaCopyTo
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, vaRecipients
End With
'Delete the temporarily workbook.
Kill stAttachment
'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
MsgBox "The e-mail has successfully been created and distributed",
vbInformation
End Sub
twick it for me?
1. I would like to instead of send out a spread sheet, attache a .txt file
to the message.
2. Pick up the email addressies if they were in colum A (To and B (CC
3. In colum C, pick up the text and put a message the will be in the body of
the email
4. In colum D, pick up the text and put a message in the subject line
5. In colum E & F have a folder path (S:\SUPPORT\CADTAR\CMS\0013) & attache
the "d0013mr.txt" file or if it can pick up file names ending in "mr"
Data (looks better in excel, around 150 lines)
A1 B1 C1 D1
E1 F1
To: CC: Body of message Subject line Path File
(e-mail address removed) (e-mail address removed) Important Monthly Fuel Surcharge Update
BAX Global Update for ARTHREX - 013847514 -
9727 S:\SUPPORT\CADTAR\CMS\9727 d9727ar.txt
VB Code
Option Explicit
Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "C:\Documents and Settings\autpbg1\My
Documents\Attachments"
Const stSubject As String = "MR Fuel update - test maco"
Const vaMsg As Variant = "This is a test, file does not mean anthing." &
vbCrLf & _
"Let me when you get this."
Const vaCopyTo As Variant = "(e-mail address removed)"
Sub Send_Active_Sheet()
Dim stFileName As String
Dim vaRecipients As Variant
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String
'Copy the active sheet to a new temporarily workbook.
With ActiveSheet
.Copy
stFileName = .Range("A1").Value
End With
stAttachment = stPath & "\" & stFileName & ".xls"
'Save and close the temporarily workbook.
With ActiveWorkbook
.SaveAs stAttachment
.Close
End With
'Create the list of recipients.
vaRecipients = VBA.Array("(e-mail address removed)")
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "",
stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.CopyTo = vaCopyTo
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, vaRecipients
End With
'Delete the temporarily workbook.
Kill stAttachment
'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
MsgBox "The e-mail has successfully been created and distributed",
vbInformation
End Sub