Results 1 to 7 of 7

Thread: macro

  1. #1
    4 Star Lounger
    Join Date
    Aug 2005
    Location
    London/Kingston, Surrey, United Kingdom
    Posts
    518
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Hi all

    The macro emails each worksheet to each eamil address which is on K1, how do I make it possible to email it to the email address which is on L1 as well, see the code below

    Many thanks,

    Sub Mail_Every_Worksheet()
    'Working in 97-2007
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String

    TempFilePath = Environ$("temp") & "\"

    If Val(Application.Version) < 12 Then
    'You use Excel 97-2003
    FileExtStr = ".xls": FileFormatNum = -4143
    Else
    'You use Excel 2007
    FileExtStr = ".xlsm": FileFormatNum = 52
    End If

    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    For Each sh In ThisWorkbook.Worksheets
    If sh.Range("K1").Value Like "?*@?*.?*" Then

    sh.Copy
    Set wb = ActiveWorkbook

    TempFileName = "Sheet " & sh.Name & " of " _
    & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    With wb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
    On Error Resume Next
    .SendMail sh.Range("K1").Value, _
    "Revenue Breakdown - P7"
    On Error GoTo 0
    .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    End If
    Next sh

    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With
    End Sub

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    Add the following declaration near the beginning of the macro:

    Dim varTo As Variant

    Below the line

    If sh.Range("K1").Value Like "?*@?*.?*" Then

    insert the following code:

    Code:
    	  If sh.Range("L1").Value Like "?*@?*.?*" Then
    		varTo = Array(sh.Range("K1").Value, sh.Range("L1").Value)
    	  Else
    		varTo = sh.Range("K1").Value
    	  End If
    Finally, change the lines

    .SendMail sh.Range("K1").Value, _
    "Revenue Breakdown - P7"


    to

    .SendMail varTo, _
    "Revenue Breakdown - P7"

  3. #3
    4 Star Lounger
    Join Date
    Aug 2005
    Location
    London/Kingston, Surrey, United Kingdom
    Posts
    518
    Thanks
    0
    Thanked 0 Times in 0 Posts
    thanks Hans it worked.

  4. #4
    4 Star Lounger
    Join Date
    Aug 2005
    Location
    London/Kingston, Surrey, United Kingdom
    Posts
    518
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Hi all again,

    Is it possible to add voting buttons to outlook (e.g Are the figures correct ? Please reply using the buttons yes or no)when running this macro from excel? If the answer is yes, can someone let me know how to do it?

    Many Thanks

  5. #5
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    The SendMail method merely sends an e-mail message, it doesn't support additional features such as voting buttons.

    To add voting buttons, you'd need to automate Outlook from Excel and set the VotingOptions property of the MailItem object. See for example including voting buttons on my email on MrExcel.

  6. #6
    4 Star Lounger
    Join Date
    Aug 2005
    Location
    London/Kingston, Surrey, United Kingdom
    Posts
    518
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Hi again,

    I have tried trun the following macro (taken from MRExcel) see beelow: When I run the macro I get the following error: Compile Error: User defined type not defined:

    Sub SendMail()

    Module3.unlockSht
    Worksheets("Sheet1").Select
    Range("A1").Select

    'Sends a specified range in an Outlook message and retains Excel formatting

    'References needed :
    'Microsoft Outlook Object Library
    'Microsoft Scripting Runtime


    Dim olApp As Outlook.Application, olMail As Outlook.MailItem
    Dim FSObj As Scripting.FileSystemObject, TStream As Scripting.TextStream
    Dim rngeSend As Range, strHTMLBody As String
    Dim strTempFilePath As String
    Dim nowTime As String
    Dim empName As String

    nowTime = Format(Range("J4").Value, "dddd-dd-mmm-yyyy")
    empName = Range("empName").Value

    On Error Resume Next
    Set rngeSend = Application.Range("C5:F47")

    Set oFSObj = CreateObject("Scripting.FilesystemObject")
    strTempFilePath = oFSObj.GetSpecialFolder(2)
    strTempFilePath = strTempFilePath & "\XLRange.htm"

    ActiveWorkbook.PublishObjects.Add(xlSourceRange, strTempFilePath, rngeSend.Parent.Name, rngeSend.Address, xlHtmlStatic).Publish True

    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(olMailItem)
    Set FSObj = New Scripting.FileSystemObject
    Set TStream = FSObj.OpenTextFile(strTempFilePath, ForReading)

    strHTMLBody = TStream.ReadAll

    TStream.Close
    Kill strTempFilePath

    olMail.HTMLBody = strHTMLBody
    olMail.VotingOptions = "Accept;Reject"
    olMail.Subject = ("Time off request for " & empName & nowTime)
    'olMail.To = ("")
    'olMail.CC = ("")
    'Will display the e-mail before sending, otherwise it will just send
    olMail.Display

    'Close Objects
    Set FSObj = Nothing
    Set olApp = Nothing
    Set olMail = Nothing
    Set TStream = Nothing

    Module3.lockSht

    End Sub

  7. #7
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    Have you heeded the part

    'References needed :
    'Microsoft Outlook Object Library
    'Microsoft Scripting Runtime

    You need to set these references in Tools | References... in the Visual Basic Editor.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •