Automatic sending email

Hi All

In a folder there are 5 workbooks named A,B,C,D,E . I want the code that
1. opens all the spreadsheets in a folder ,
2. automatically enable macros in them
3. Then copy sheet1 in workbook A and email it to a list of recipients.

I hope anyone can figure it out for me.

Thanks a lot.

Asking for an entire application to be written for you isn't likely to generate many responses, sorry.

Some pointers for you...

1. Opening all of the spreadsheets in a folder is fairly straightforward.

Sub OpenAllInFolder(ByVal sFolderPath As String, Optional sMask="*.xl*)

Dim sCurrentFile as String

On Error GoTo FileError

sFolderPath=Trim(sFolderPath)

If Right(sFolderPath,1)<>"\" Then
  sFolderPath=sFolderPath & "\"
End If

sCurrentFile=Dir(sFolderPath & sMask)

While sCurrentFile<>""

  Workbooks.Open(sFolderPath & sCurrentFile)
  sCurrentFile=Dir()

Wend

Exit Sub

FileError:

MsgBox "That folder has given me a boo-boo"

End Sub

2. For reasons that should be blindingly obvious it's not possible to get Excel to open a workbook and automatically enable macros in it, unless you have proper security certificates set up. Working out how to do this is left as an exercise for the reader.

3. Have a look at the workbook .SendMail method, but expect to have to confirm that you don't object to a macro sending mail on your behalf. It's easy to find other methods of sending mail from Excel, but I've never found one that doesn't involve the user at least pressing the "Send" button.

Does this get you started?

Hi Andrew the function that you sent me over is giving some problem at Optional Smask parameter.

Snb, In a folder suppose f1 there are 5 different workbooks. so I want to automatically open all of them at 7pm evryday and then send the sheet1 in workbook A to a list of recipients.

I hope anyone can figure out my problem.

Thanks a lot for your help.

Originally Posted by aman1234

Hi Andrew the function that you sent me over is giving some problem at Optional Smask parameter.

Have you tried applying some fix?


Seriously, what is the issue. When you call the sub-routine are you putting brackets around the parameters? Are you specifying an sMask parameter or are you leaving it as default?

Hi

I have written the following code but it doesn't do anything.

Private Sub OpenAllInFolder(ByVal sFolderPath As String, Optional sMask = "*.xl*")

Dim sCurrentFile As String

On Error GoTo FileError

sFolderPath = Trim(sFolderPath)

If Right(sFolderPath, 1) <> "\" Then
  sFolderPath = sFolderPath & "\"
End If

sCurrentFile = Dir(sFolderPath & sMask)

While sCurrentFile <> ""

  Workbooks.Open (sFolderPath & sCurrentFile)
  sCurrentFile = Dir()

Wend

Exit Sub

FileError:

MsgBox "That folder has given me a boo-boo"

End Sub
Private Sub CommandButton1_Click()
OpenAllInFolder ("C:\Documents and Settings\Amanpreet Kaur\Desktop\Project")
End Sub

Please help me to figure it out.

Thanks

I've just tested that code on my machine and it works absolutely fine.

Do you have any Excel files in the specified directory?

Thanks Andrew. It worked fine at my end too. I was using the wrong folder name n thats way I didn't work earlier.

Ok. now could you please help me to send sheet1 in opened workbook A to various recipients.

Thanks a lot for your help so far.

As I said further up there ^^^^ there's a workbook .SendMail method, used in the format:

ActiveWorkbook.SendMail Recipients:="Fred Bloggs; Joe Smith", Subject:="Data for you"

Excel will warn you that a macro is trying to send mail on your behalf, but (IMO) it's easier to work this way than to create an Outlook object.

As there are around 6 workbooks opened using the code in last post so how can I refer to particular workbook and send the sheet1 in that workbook using vba.

My current workbook is Test.
The next 6 workbooks which are opened using the code that you sent me over are named as A,B,C,D,E,F.

And now I want to send sheet1 in workbook A from my current workbook Test using vba.

I hope you understand what I mean.

Thanks a lot.

If you're interested, I used the following sub-routine to send mails from the scheduling spreadsheet that I use. Obviously it will require some hacking around to meet your needs, but it might give you the basics on how e-mails can be sent, via Outlook, from Excel.

Sub SendConfirmationEMail(ByVal Recipient, ByVal ProjectID, ByVal ProjectName, ByVal Task, ByVal StartDate, ByVal EndDate, ByVal DMResource, Optional ByVal CCDM = "")

Dim OutApp As Object
Dim OutMail As Object
Dim OutAcc As Object
Dim strBody As String
Dim NewLine

NewLine = Chr(13)

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

strBody = "This is an automated confirmation." & NewLine & NewLine
strBody = strBody & "A new work item for project " & ProjectID & " has been added to the DM team schedule." & NewLine & NewLine
strBody = strBody & "Task          : " & Task & NewLine
strBody = strBody & "Start         : " & StartDate & NewLine
strBody = strBody & "Deadline   : " & EndDate & NewLine
strBody = strBody & "Assigned   : " & DMResource & NewLine & NewLine
strBody = strBody & "If you believe any of the above details are incorrect then please contact me to discuss." & NewLine & NewLine
strBody = strBody & "Andrew"

With OutMail
  .To = Recipient
  .CC = CCDM
  .BCC = ""
  .Subject = ProjectID & "-" & ProjectName
  .Body = strBody
  .display
End With

End Sub

I wrote this quite some time ago, so it's not as neat as it could be, but it does the job.

You can identify which workbook you're talking about by:

a. Refering to it by name, e.g. Workbooks("My workbook.xlsx").SendMail

b. Or by index number, e.g. Workbooks(1).SendMail

c. Or by assigning the workbook to a workbook object, e.g.

Dim wbkMyBook as Workbook

Set wbkMyWorkbook=Workbooks.Open (sFolderPath & sCurrentFile)

wbkMyWorkbook.SendMail Recipients:="Fred Bloggs"

d. By activating it before you use it and then using the Activeworkbook object

e. By running the macro code from within the workbook you want to use and using the ThisWorkbook object.

f. Probably lots of other ways that the good people here will be kind enough to suggest.


If you only want to send Sheet1 then I'd copy sheet 1 from the target workbook to a new workbook and assign that workbook to a workbook object.

Does that help?

Andrew,
If I write the following code then it gives an error message that this workbook is already opened.

Set wbkMyWorkbook=Workbooks.Open (sFolderPath & sCurrentFile)

As we have opened all the workbooks using the code you sent me earlier so I am confused. Can you please send me the exact that solves my purpose.

Thanks a lot for your help .

OK, there's a number of problems that I can see with a 30 seconds look through:

1. You need to fix your close code tag in your previous post.

2. The line of code you quoted in the previous post doesn't work because it's meant to be used in the sub-routine to open the files, not in addition to it. However, as you're opening multiple files you'll need to have a method for assigning each of them to a different workbook object - using an array, for example.

3. I suspect that your RangeToHTML function is returning nothing. I'd try at least passing rng to it as a parameter and see if that helps.

4. While you're still coding I'd take out all of the On Error statements so that you can see where errors occur.

Hi Andrew

I tried to solve it a lot but still the email that is being sent is blank(Without body).

Please can you send me the code to solve this purpose.

Thanks

Andrew: I figured out something: If i wrire the following code which sends an attachment with email then it works:

Sub Mail_Selection_Range_Outlook_Body(a As String)

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
   Dim wbkMyBook As Workbook


    Set rng = Workbooks("C:\a.xls").Worksheets("Slide").UsedRange
      
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = New Outlook.Application
    Set OutMail = OutApp.CreateItem(olMailItem)

      With OutMail
      
               .Recipients.Add "ABC"                
        .Subject = "Reminder"
      .Attachments.Add ("C:\a.xls")
        .Send
    End With
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

But if I want to just display "Slide" sheet of "a.xls" in the body of email as follows then it doesn't do anything but send a blank email:

Sub Mail_Selection_Range_Outlook_Body(a As String)

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
   Dim wbkMyBook As Workbook


    Set rng = Workbooks("C:\a.xls").Worksheets("Slide").UsedRange
      
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = New Outlook.Application
    Set OutMail = OutApp.CreateItem(olMailItem)

      With OutMail
      
               .Recipients.Add "ABC"
                
        .Subject = "Reminder"
        .HTMLBody = RangetoHTML(rng)
            .Send
    End With
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        End With
 
    
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    
    TempWB.Close SaveChanges:=False
 
    
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Please help me out to send "Slide" sheet in the body of the email.

Thanks a lot

Can anyone please figure out my problem?

Thanks

Hi guys

I still couldn't figure out how to do that part. Please help me out with this.

Thanks