Àx¦s®æ¶W³sµ²¹q¤l¶l¥ó³]©w

takeshilin88

½Ð°Ý¦U¦ì¤j¤j¡G
·Q¦bEXCELªºÀx¦s®æ¤¤³]©w¶W³sµ²¡A
¶W³sµ²¤¤ªº¹q¤l¶l¥ó³]©w->¥D¦®  ¡A·Q­n¦Û°ÊÅã¥Ü¥Á°ê¦~¤ë¡C
¤]´N¬O»¡³]©w¦n¤§«á¡A¥u­nÂI¸ÓÀx¦s®æ¡A·|¦Û°Ê«Ø¥ß¹q¤l¶l¥ó¡A
¥B¹q¤l¶l¥óªº¡u¥D¦®¡vÄæ¦ì·|¦Û°ÊÅã¥Ü¥Ø«eªº¥Á°ê¦~¥÷¤Î¤ë¥÷¡AEX: ¦Û°Ê§ì¨ú105¦~2¤ë¥÷¡A©Ò¥HÅã¥Ü105-2
½Ð¦U¦ì¤j¤jÀ°À°¦£¡AÁÂÁÂ

takeshilin88

¦^´_ 19# ML089

·PÁÂML089¤jªºÀ°¦£¡A²×©ó¦¨¥\¤F¡A¥nÀY«ôÁÂ....

ML089

¦^´_ 18# takeshilin88

°Ñ¦Òºô­¶
http://grant88.pixnet.net/blog/p ... 1%E9%83%B5%E4%BB%B6

'VBA ¨Ï¥Î CDO ±H°e¶l¥ó
'¨Ï¥ÎCDO±H°e¶l¥ó
'¤£¥²³z¹LOutlook±H°e
'¥²¶·³]©w¤Þ¥Î¶µ¥Ø¡uMicrosoft CDO for Windows 2000 Library¡v

Option Explicit

'«Å§iÅܼƤΰѼÆ
Dim objCDO As CDO.Message
Public theRng As Range
Const myUserId = "yourID" '½Ð­×§ï¦¨§Aªº±b¸¹
Const myPassword = "yourPSW" '½Ð­×§ï¦¨§Aªº±b¸¹±K½X
Const mySMTPServer = "smtp.gmail.com" '½Ð­×§ï¦¨§Aªº±H°e¶l¥ó¦øªA¾¹
Const mySMTPport = 465 '¶·­×§ï¦¨§Aªº°e¥ó¦øªA¾¹¨Ï¥ÎªºPORT, Gmail¨Ï¥Îªº¬O465

'¬yµ{±±¨î
Sub Main()
  Application.StatusBar = "Sending..." 'ª¬ºA°T®§Åã¥Ü
  Set objCDO = New CDO.Message '³Ð«Ø·sªºª«¥ó
  ServerSetting '¦øªA¾¹³]¸m
  Set theRng = ActiveSheet.UsedRange '¨úªº§@¥Î¤u§@ªí¨Ï¥Î½d³ò
  fillNsend '¶ñ¥R¶l¥ó¦UÄæ¦ì¸ê°T¨Ã±H°e
  Set objCDO = Nothing 'ÄÀ©ñª«¥ó
  Application.StatusBar = False '«ì´_ª¬ºA°T®§
End Sub

'³]¸m¶l¥ó¦øªA¾¹°Ñ¼Æ
'³o¬O¥ÎGmail´ú¸Õ¦¨¥\ªº°Ñ¼Æ, ½Ð°Ñ¾\ Email Server ªº³]¸m»¡©ú
Sub ServerSetting()
  With objCDO
    With .Configuration.Fields
      .Item(cdoSendUsingMethod) = cdoSendUsingPort
      .Item(cdoSendUserName) = myUserId
      .Item(cdoSendPassword) = myPassword
      .Item(cdoSMTPServer) = mySMTPServer
      .Item(cdoSMTPAuthenticate) = True
      .Item(cdoSMTPServerPort) = mySMTPport
      .Item(cdoSMTPUseSSL) = True
      .Update
    End With
  End With
End Sub

'¶ñ¥RÄæ¦ì¸ê°T«á±H°e
Sub fillNsend()
  With objCDO
    .From = """crdotlin""<" & myUserId & "@" & VBA.Mid(mySMTPServer, 6) & ">"
    .To = ActiveSheet.Range("a2").Text
    .Subject = "Test Test"
    .HTMLBody = RangetoHTML(theRng)
    '³]©w­«­n©Ê
    '.Fields("urn:schemas:mailheader:importance") = 2
    '.Fields("urn:schemas:httpmail:importance") = 2
    .Fields(cdoImportance) = cdoHigh
    .Fields.Update
    .Send
  End With
End Sub

'´ú¸Õ
Sub TestSendSheet()
  Dim Sht As Worksheet
  '³B²z©Ò¦³¤u§@ªí
  For Each Sht In ThisWorkbook.Worksheets
    Sht.Activate '±Ò°Ê¬°§@¥Î¤u§@ªí
    '¦pªGA2Àx¦s®æ¦¡¶l¥ó¦ì§}, «h±N¦¹¤u§@ªí±H°e¨ì¸Ó«H½c
    If ActiveSheet.Range("a2").Value Like "*@*" Then Main
  Next
End Sub



'¤Þ¥Î Ron de Bruin ªº RangetoHTML µ{§Ç
'Reference: http://www.rondebruin.nl/cdo.htm
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2007
    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"

    'Copy the range and create a new workbook to past the data in
    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

    'Publish the sheet to a htm file
    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

    'Read all data from the htm file into RangetoHTML
    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=")

    'Close TempWB
    TempWB.Close savechanges:=False

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

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

takeshilin88

¦^´_ 17# ML089

ML089¤j±z¦n¡G

ÁÂÁ±zªº´£¨Ñªº¤½¦¡¡A¤w¸g¥i¥H§â·Q­nªº½d³ò¶K¨ì·s¶l¥ó¤º¤å¤¤¤F¡A
¥t¥~½Ð±Ð¡A¦³¿ìªk³sEXCEL½d³ò¤¤ªº®æ¦¡¤@¨Ö¶K¨ì¤º¤å¶Ü¡H
¦]¬°·Q¥Î¦p¹Ï¤¤Á~¸ê³Uªºªí®æ¶K¨ì·s¶l¥ó¤º¤å¤¤¡A
·P¿E¤£ºÉ~~

¤U¸ü (175.2 KB)

2016-3-2 08:49

ML089

¦^´_ 16# takeshilin88

=HYPERLINK("mailto:"&A2&"?subject="&B2&"&body="&L2:N3, "µo«H")
§ï¬°
=HYPERLINK("mailto:"&A2&"?subject="&B2&"&body="&L2&"%0A"&M2&"%0A"&N2&"%0A", "µo«H")

takeshilin88

¦^´_ 15# ­ã´£³¡ªL


­ã¤j±z¦n¡G

¥D­n¬O·Q§âexcelªº½d³ò¶K¨ì·s¶l¥óªº¤º¤å¤¤¡A
¦ý¬O¸Õ¹L
=HYPERLINK("mailto:"&A2&"?subject="&B2&"&body="&L2:N3, "µo«H")
¨ä¤¤L2:N3¬O·Q­n§â³o½d³òªº¸ê®Æ(§t®æ¦¡)¶K¨ì·s¶l¥óªº¤º¤å¤¤¡A
¦ý¬O¤½¦¡¥X²{#VALUE!
½Ð°Ý¦³¸Ñ¨Mªº¤èªk¶Ü¡H
ÁÂÁÂ

­ã´£³¡ªL

¦^´_ 14# takeshilin88

¢Ò¢±¬O¤½¦¡¡A¬°¦ó­n½Æ»s³o®æ¡H
=HYPERLINK("mailto:"&A2&"?subject="&B2, "µo«H")¡@

³o¼Ë°£¦¬¥ó¤H¤Î¥D¦®¥~¡A¤º¤å¬OªÅªº¡A
¤]³\¸ÕµÛ¤F¸Ñ¤½¦¡­ì²z¡A¦A¦Û¦æÀ|¸Õ¥h®M¬Ý¬Ý§a¡I

takeshilin88

¦^´_ 13# ­ã´£³¡ªL

¤U¸ü (54.12 KB)

2016-2-26 19:01

    ­ì¤è¦¡¡G
    1.·í«ö¤UD2Àx¦s®æªº¡uµo«H¡v¤§«á¡A
    2.¦Û°Ê¶}±Ò·s¶l¥ó(¦¬¥óªÌ¡B¥D¦®¦Û°Ê²£¥Í)

    ¥i¥H§ï¦¨³o¼Ë¶Ü¡H
    1.·í«ö¤UD2Àx¦s®æªº¡uµo«H¡v¤§«á¡A
    2.EXCEL¦Û°Ê½Æ»sA2:D2¡A
    3.¦Û°Ê¶}±Ò·s¶l¥ó(¦¬¥óªÌ¡B¥D¦®¦Û°Ê²£¥Í)
    ±µ¤U¨Ó§Ú¥u­nª½±µ¨ì·s¶l¥óªº¤º®e¡A«ö¡u¶K¤W¡v¡A´N¯à§âA2:D2ªºªí®æ¶K¨ì·s¶l¥ó¤º®e¤¤¡A
    «ö¤UD3Àx¦s®æ¥ç¦P¡A·|¦Û°Ê½Æ»sA3:D3
   
    ³o¼Ë¤£¾å±o­ã¤j¤F¸Ñ§Úªº·N«ä¤F¶Ü¡H

    ÁÂÁÂ~~

­ã´£³¡ªL

¦^´_ 12# takeshilin88


¤°»ò·N«ä¡HÁ|­Ó¨Ò¤l¡H

takeshilin88

¦^´_ 10# ­ã´£³¡ªL


    ­ã¤j±z¦n¡G
    ¥i¥H¦A½Ð±Ð¤@¤U¡G
    ¥H±z­ì¥»´£¨ÑªºÀɮסA

    ¥i¥H³]©w¥X¥H¤Uªº¤è¦¡¶Ü¡H
    ·í«ö¤UD2ªº¡uµo«H¡v¤§«á¡A¥ý½Æ»sA2:D2¡AµM«á¦A¡u·s¼W¹q¤l¶l¥ó¡v¡AµM«á¨ì·s¶l¥óªº¤º®eª½±µ¶K¤WA2:D2Àx¦s®æ¸ê®Æ¡H
    ·í«ö¤UD3ªº¡uµo«H¡v¤§«á¡A¥ý½Æ»sA3:D3¡AµM«á¦A¡u·s¼W¹q¤l¶l¥ó¡v¡AµM«á¨ì·s¶l¥óªº¤º®eª½±µ¶K¤WA3:D3Àx¦s®æ¸ê®Æ¡H

    ·P®¦~~