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

[Guest]

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 Recipients:="(e-mail address removed)"
'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

 

[Guest]

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) = "(e-mail address removed)"
strRecipients(2) = "(e-mail address removed)"

ActiveWorkbook.SendMail Recipients:=strRecipients
End Sub



Public Sub EmailMulti_LiteralValues()
ActiveWorkbook.SendMail Recipients:=Array("wcpfiste", "(e-mail address removed)")
End Sub



Regards,
Bill