ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   vba script code - for emails and creating directory as req'd: (https://www.excelbanter.com/excel-programming/371825-vba-script-code-emails-creating-directory-reqd.html)

jatman

vba script code - for emails and creating directory as req'd:
 
i have the following code for a purchase order:

Sub POInv()
' Macro recorded 8/28/2006 by Jat
'
'Sub SaveName() - multiple steps
ActiveSheet.Copy 'creates a new one page workbook with a copy of
the activesheet in it, this becomes the activesheet/book
ActiveSheet.Name = Range("M5").Value 'renames the active sheet
(from ActiveSheet.Copy) to the purchase order value located in cell M5
strdate = Format(Now, "mm-dd-yy h-mm-ss")
ActiveWorkbook.SaveAs "C:\Documents and Settings\All
Users\Documents\Purchase Orders\" & ActiveSheet.Name & " " & strdate &
".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, _
CreateBackup:=False 'saves the renamed active sheet to the
designated folder
'End Sub

'Sub Email() - sends a copy of the email to the recipients(should be
accounts payable department, or similar)
ActiveWorkbook.SendMail "
'End Sub Email()

'Sub PrintOut() - prints out one copy after the sheet has been emailed,
then closes it
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.Close SaveChanges:=True 'don't ask - kind of looks
good.
'End Sub

'Sub Count() - increases the PO number (stored in cell K8 and displayed
in M5)
mycount = Range("K8") + 1
Range("K8") = mycount
'End Sub

'Sub ClearContents() - Clears the contents in selected cells Range, and
reverts the actual PO to it's original form

Range("M9,M11,M13,M15,D11:G15,A18:L32,E33,G33,J33, C35,E35,H35,B37:M40,M44,A45:G45").Select
Selection.ClearContents
Application.ScreenUpdating = True
Range("D11:G11").Select
'End Sub

'Sub AutoSave() - saves the blank purchase order with new PO number
ActiveWorkbook.Save
'End Sub

End Sub


now, keeping everything simple as pie (like above), how do i get it to do
the following:
send to mulitple recipients
automatically create the directory if req'd

thank you,

jatman

Bill Pfister

vba script code - for emails and creating directory as req'd:
 

This sub uses traditional VBA to create a folder - you could also use VB
script, but this will suffice.

Public Sub CreateFolder(strFolder As String)
On Error GoTo ErrHandler

' this essentially checks to see if there are any files in the named
folder
If (Len(Dir(strFolder)) = 0) Then
MkDir (strFolder)
End If

Exit Sub

ErrHandler:
End Sub


Here are two different methods for adding multiple recipients.

Public Sub EmailMulti_Predefined()
Dim strRecipients() As String

ReDim strRecipients(0 To 2) As String

strRecipients(0) = "wcpfiste"
strRecipients(1) = "
strRecipients(2) = "

ActiveWorkbook.SendMail Recipients:=strRecipients
End Sub



Public Sub EmailMulti_LiteralValues()
ActiveWorkbook.SendMail Recipients:=Array("wcpfiste", ")
End Sub



Regards,
Bill



"jatman" wrote:

i have the following code for a purchase order:

Sub POInv()
' Macro recorded 8/28/2006 by Jat
'
'Sub SaveName() - multiple steps
ActiveSheet.Copy 'creates a new one page workbook with a copy of
the activesheet in it, this becomes the activesheet/book
ActiveSheet.Name = Range("M5").Value 'renames the active sheet
(from ActiveSheet.Copy) to the purchase order value located in cell M5
strdate = Format(Now, "mm-dd-yy h-mm-ss")
ActiveWorkbook.SaveAs "C:\Documents and Settings\All
Users\Documents\Purchase Orders\" & ActiveSheet.Name & " " & strdate &
".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, _
CreateBackup:=False 'saves the renamed active sheet to the
designated folder
'End Sub

'Sub Email() - sends a copy of the email to the recipients(should be
accounts payable department, or similar)
ActiveWorkbook.SendMail "
'End Sub Email()

'Sub PrintOut() - prints out one copy after the sheet has been emailed,
then closes it
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.Close SaveChanges:=True 'don't ask - kind of looks
good.
'End Sub

'Sub Count() - increases the PO number (stored in cell K8 and displayed
in M5)
mycount = Range("K8") + 1
Range("K8") = mycount
'End Sub

'Sub ClearContents() - Clears the contents in selected cells Range, and
reverts the actual PO to it's original form

Range("M9,M11,M13,M15,D11:G15,A18:L32,E33,G33,J33, C35,E35,H35,B37:M40,M44,A45:G45").Select
Selection.ClearContents
Application.ScreenUpdating = True
Range("D11:G11").Select
'End Sub

'Sub AutoSave() - saves the blank purchase order with new PO number
ActiveWorkbook.Save
'End Sub

End Sub


now, keeping everything simple as pie (like above), how do i get it to do
the following:
send to mulitple recipients
automatically create the directory if req'd

thank you,

jatman



All times are GMT +1. The time now is 04:37 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com