By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,681 Members | 1,854 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,681 IT Pros & Developers. It's quick & easy.

Copy and Paste Excel Sheet in to Outlook Email

100+
P: 283
Hello,

Ok I am having a problem where I am taking an Excel File and cutting and pasting the info from the first sheet into an Email on a button click on a form.

I actually have it working but my problem is that it will only do it one time and then I have to close the database and re-open it to get it to work again. I think that the problem is that when the program executes I have it creating a temp file and copying the info from the temp and then pasting it, then its supposed to Kill the temp file but i dont think it is until I close out of the db for some reason.

Any help with this would be much appreciated.

My code is in two parts. One is creating the email and putting everything in, the other is a function to cut and paste the excel info.

create temp file, cut and paste:
Expand|Select|Wrap|Line Numbers
  1. Function RangetoHTML(rng As Range)
  2.     Dim fso As Object
  3.     Dim ts As Object
  4.     Dim TempFile As String
  5.     Dim TempWB As Workbook
  6.  
  7.     TempFile = Environ("temp") & "/" & Format(Date, "dd-mm-yy h-mm-ss") & ".htm"
  8.  
  9.     'Copy the range and create a new workbook to past the data in
  10.     rng.Copy
  11.     Set TempWB = Workbooks.Add(1)
  12.     With TempWB.Sheets(1)
  13.         .Cells(1).PasteSpecial Paste:=8
  14.         .Cells(1).PasteSpecial xlPasteValues, , False, False
  15.         .Cells(1).PasteSpecial xlPasteFormats, , False, False
  16.         .Cells(1).Select
  17.         .Application.CutCopyMode = False
  18.         On Error Resume Next
  19.         .DrawingObjects.Visible = True
  20.         .DrawingObjects.Delete
  21.         On Error GoTo 0
  22.     End With
  23.  
  24.     'Publish the sheet to a htm file
  25.     With TempWB.PublishObjects.Add( _
  26.          SourceType:=xlSourceRange, _
  27.          FileName:=TempFile, _
  28.          Sheet:=TempWB.Sheets(1).Name, _
  29.          Source:=TempWB.Sheets(1).UsedRange.Address, _
  30.          HtmlType:=xlHtmlStatic)
  31.         .Publish (True)
  32.     End With
  33.  
  34.     'Read all data from the htm file into RangetoHTML
  35.     Set fso = CreateObject("Scripting.FileSystemObject")
  36.     Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
  37.     RangetoHTML = ts.ReadAll
  38.     ts.Close
  39.     RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
  40.                           "align=left x:publishsource=")
  41.  
  42.     'Close TempWB
  43.     TempWB.Close savechanges:=False
  44.  
  45.     'Delete the htm file we used in this function
  46.     Kill (TempFile)
  47.  
  48.     Set ts = Nothing
  49.     Set fso = Nothing
  50.     Set TempWB = Nothing
  51.  
  52. End Function
  53.  
Create email:
Expand|Select|Wrap|Line Numbers
  1. Private Sub CreateMail()
  2.  
  3. Dim bStarted As Boolean
  4. Dim oOutlookApp As Outlook.Application
  5. Dim oItem As Outlook.MailItem
  6. Dim rng As Range
  7. Dim XL_File As String
  8.  
  9. XL_File = "C:\test.xlsx"
  10.  
  11. On Error Resume Next
  12.  
  13. Dim xlApp As Excel.Application
  14. Set xlApp = Nothing
  15. Set xlApp = CreateObject("Excel.Application")
  16. xlApp.Visible = True
  17. xlApp.Workbooks.Open XL_File, , False
  18. 'Set xlApp = Nothing
  19.  
  20. Set rng = Nothing
  21. Set rng = xlApp.Sheets(1).UsedRange
  22. 'Set rng = Workbooks.Open("C:\test.xlsx").Sheets(1).UsedRange
  23.  
  24. 'Get Outlook if it's running
  25. Set oOutlookApp = GetObject(, "Outlook.Application")
  26. If Err <> 0 Then
  27.     'Outlook wasn't running, start it from code
  28.     Set oOutlookApp = CreateObject("Outlook.Application")
  29.     bStarted = True
  30. End If
  31.  
  32. 'Create new mail item
  33. Set oItem = oOutlookApp.CreateItem(olMailItem)
  34.  
  35. With oItem
  36.     'Set the recipient for the new email
  37.     .To = "someone@somewhere.com"
  38.     .Subject = "Hello"
  39.     .Attachments.Add "C:\test.xlsx"
  40.     .HTMLBody = RangetoHTML(rng)
  41.     .Display
  42. End With
  43.  
  44. 'If bStarted Then
  45.     'If we started Outlook from code, then close it
  46.     'oOutlookApp.Quit
  47. 'End If
  48.  
  49. 'Clean up
  50.  
  51. Set oItem = Nothing
  52. Set oOutlookApp = Nothing
  53. Set rng = Nothing
  54.  
  55. End Sub
  56.  
Jan 25 '12 #1
Share this question for a faster answer!
Share on Google+

Post your reply

Sign in to post your reply or Sign up for a free account.