ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] outlook¤èªk§ï¬°¨t²Î¹w³]ªº¶l¥óµ{¦¡

[µo°Ý] outlook¤èªk§ï¬°¨t²Î¹w³]ªº¶l¥óµ{¦¡

½Ð±Ð¦U¦ì¤j¤j¡G
­ì¥»¨Ï¥Îoutlook¤èªk±H«H¡A
¦]¦ÑÁó­n¨D­n§ï¦¨¨t²Î¹w³]ªº¶l¥óµ{¦¡±H«H(windows live mail)¡A
½Ð°Ý­n¦p¦ó­×§ï¡H
  1. Sub Send_Range_Body()

  2.     Dim rng As Range
  3.     Dim OutApp As Object
  4.     Dim OutMail As Object
  5.     Application.ReferenceStyle = xlA1

  6.     'Set rng = Nothing
  7.     On Error Resume Next
  8.     Set rng = Sheets("sheet1").Range("A4:F20").SpecialCells(xlCellTypeVisible)
  9.     On Error GoTo 0

  10.     If rng Is Nothing Then
  11.         MsgBox "½Ð¿ï¾Ü¤@­Ó¿ï°Ï¨Ã¥B¤u§@ªí¤£¯à¬O«OÅ@ª¬ºA¡C" & _
  12.                vbNewLine & "½Ð¦A¦¸¹Á¸Õ¡C", vbOKOnly
  13.         Exit Sub
  14.     End If

  15.     With Application
  16.         .EnableEvents = False
  17.         .ScreenUpdating = False
  18.     End With

  19.     Set OutApp = CreateObject("Outlook.Application")
  20.     Set OutMail = OutApp.CreateItem(0)

  21.     On Error Resume Next
  22.     With OutMail
  23.         .To = "[email protected]"
  24.         '.CC = "°Æ¥»µ¹½Ö"  
  25.         '.BCC = "±K¥ó°Æ¥»µ¹½Ö"   
  26.         .Subject = "hello"  '¥D¦®
  27.         .HTMLBody = RangetoHTML(rng)  
  28.         .Display
  29.         
  30.     End With
  31.     On Error GoTo 0

  32.     With Application
  33.         .EnableEvents = True
  34.         .ScreenUpdating = True
  35.     End With

  36.     Set OutMail = Nothing
  37.     Set OutApp = Nothing
  38. End Sub

  39. 'FUNCTION RangetoHTML
  40. Function RangetoHTML(rng As Range)
  41. ' Changed by Ron de Bruin 28-Oct-2006
  42. ' Working in Office 2000-2016
  43.     Dim fso As Object
  44.     Dim ts As Object
  45.     Dim TempFile As String
  46.     Dim TempWB As Workbook

  47.     TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

  48.     'Copy the range and create a new workbook to past the data in
  49.     rng.Copy
  50.     Set TempWB = Workbooks.Add(1)
  51.     With TempWB.Sheets(1)
  52.         .Cells(1).PasteSpecial Paste:=8
  53.         .Cells(1).PasteSpecial xlPasteValues, , False, False
  54.         .Cells(1).PasteSpecial xlPasteFormats, , False, False
  55.         .Cells(1).Select
  56.         Application.CutCopyMode = False
  57.         On Error Resume Next
  58.         .DrawingObjects.Visible = True
  59.         .DrawingObjects.Delete
  60.         On Error GoTo 0
  61.     End With

  62.     'Publish the sheet to a htm file
  63.     With TempWB.PublishObjects.Add( _
  64.          SourceType:=xlSourceRange, _
  65.          Filename:=TempFile, _
  66.          Sheet:=TempWB.Sheets(1).Name, _
  67.          Source:=TempWB.Sheets(1).UsedRange.Address, _
  68.          HtmlType:=xlHtmlStatic)
  69.         .Publish (True)
  70.     End With

  71.     'Read all data from the htm file into RangetoHTML
  72.     Set fso = CreateObject("Scripting.FileSystemObject")
  73.     Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
  74.     RangetoHTML = ts.readall
  75.     ts.Close
  76.     RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
  77.                           "align=left x:publishsource=")

  78.     'Close TempWB
  79.     TempWB.Close savechanges:=False

  80.     'Delete the htm file we used in this function
  81.     Kill TempFile

  82.     Set ts = Nothing
  83.     Set fso = Nothing
  84.     Set TempWB = Nothing
  85. End Function
½Æ»s¥N½X

        ÀR«ä¦Û¦b : ¤H¨ÆªºÁ}Ãø»PµZ¿i¡A´N¬O¤@ºØ¦ÒÅç¡C
ªð¦^¦Cªí ¤W¤@¥DÃD