+ Reply to Thread
Results 1 to 19 of 19

Automatic sending email

Hybrid View

  1. #1
    Forum Contributor
    Join Date
    02-20-2009
    Location
    bristol
    MS-Off Ver
    Excel 2003
    Posts
    882

    Re: Automatic sending email

    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 .

  2. #2
    Forum Contributor
    Join Date
    02-20-2009
    Location
    bristol
    MS-Off Ver
    Excel 2003
    Posts
    882

    Re: Automatic sending email

    I am writing the following code but It doesn't include anything in the body and an empty email is being sent.
    
    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:\Documents and Settings\Desktop\A1").Worksheet(a).UsedRange
        
        On Error GoTo 0
    
        
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
    
        Set OutApp = New Outlook.Application
        Set OutMail = OutApp.CreateItem(olMailItem)
    
        On Error Resume Next
        With OutMail
          
                   .Recipients.Add "Smith Morgan"
                    
            .Subject = "Reminder"
            .HTMLBody = RangetoHTML(rng)
            .Send
        End With
        On Error GoTo 0
    
        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
            On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            On Error GoTo 0
        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
    Last edited by romperstomper; 08-15-2011 at 08:11 AM. Reason: fix code tags

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1