takeshilin88

回復 10# 准提部林

謝謝准大~~
感激不盡~~~~

takeshilin88

回復 10# 准提部林


    准大您好：
    可以再請教一下：
    以您原本提供的檔案，

    可以設定出以下的方式嗎？
    當按下D2的「發信」之後，先複製A2:D2，然後再「新增電子郵件」，然後到新郵件的內容直接貼上A2:D2儲存格資料？
    當按下D3的「發信」之後，先複製A3:D3，然後再「新增電子郵件」，然後到新郵件的內容直接貼上A3:D3儲存格資料？

    感恩~~

准提部林

回復 12# takeshilin88


什麼意思？舉個例子？

takeshilin88

回復 13# 准提部林

下載 (54.12 KB)

2016-2-26 19:01

    原方式：
    1.當按下D2儲存格的「發信」之後，
    2.自動開啟新郵件(收件者、主旨自動產生)

    可以改成這樣嗎？
    1.當按下D2儲存格的「發信」之後，
    2.EXCEL自動複製A2:D2，
    3.自動開啟新郵件(收件者、主旨自動產生)
    接下來我只要直接到新郵件的內容，按「貼上」，就能把A2:D2的表格貼到新郵件內容中，
    按下D3儲存格亦同，會自動複製A3:D3
   
    這樣不曉得准大了解我的意思了嗎？

    謝謝~~

准提部林

回復 14# takeshilin88

Ｄ２是公式，為何要複製這格？
=HYPERLINK("mailto:"&A2&"?subject="&B2, "發信")　

這樣除收件人及主旨外，內文是空的，
也許試著了解公式原理，再自行嚐試去套看看吧！

takeshilin88

回復 15# 准提部林


准大您好：

主要是想把excel的範圍貼到新郵件的內文中，
但是試過
=HYPERLINK("mailto:"&A2&"?subject="&B2&"&body="&L2:N3, "發信")
其中L2:N3是想要把這範圍的資料(含格式)貼到新郵件的內文中，
但是公式出現#VALUE!
請問有解決的方法嗎？
謝謝

ML089

回復 16# takeshilin88

=HYPERLINK("mailto:"&A2&"?subject="&B2&"&body="&L2:N3, "發信")
改為
=HYPERLINK("mailto:"&A2&"?subject="&B2&"&body="&L2&"%0A"&M2&"%0A"&N2&"%0A", "發信")

takeshilin88

回復 17# ML089

ML089大您好：

謝謝您的提供的公式，已經可以把想要的範圍貼到新郵件內文中了，
另外請教，有辦法連EXCEL範圍中的格式一併貼到內文嗎？
因為想用如圖中薪資袋的表格貼到新郵件內文中，
感激不盡~~

下載 (175.2 KB)

2016-3-2 08:49

ML089

回復 18# takeshilin88

參考網頁
http://grant88.pixnet.net/blog/p ... 1%E9%83%B5%E4%BB%B6

'VBA 使用 CDO 寄送郵件
'使用CDO寄送郵件
'不必透過Outlook寄送
'必須設定引用項目「Microsoft CDO for Windows 2000 Library」

Option Explicit

'宣告變數及參數
Dim objCDO As CDO.Message
Public theRng As Range
Const myUserId = "yourID" '請修改成你的帳號
Const myPassword = "yourPSW" '請修改成你的帳號密碼
Const mySMTPServer = "smtp.gmail.com" '請修改成你的寄送郵件伺服器
Const mySMTPport = 465 '須修改成你的送件伺服器使用的PORT, Gmail使用的是465

'流程控制
Sub Main()
  Application.StatusBar = "Sending..." '狀態訊息顯示
  Set objCDO = New CDO.Message '創建新的物件
  ServerSetting '伺服器設置
  Set theRng = ActiveSheet.UsedRange '取的作用工作表使用範圍
  fillNsend '填充郵件各欄位資訊並寄送
  Set objCDO = Nothing '釋放物件
  Application.StatusBar = False '恢復狀態訊息
End Sub

'設置郵件伺服器參數
'這是用Gmail測試成功的參數, 請參閱 Email Server 的設置說明
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

'填充欄位資訊後寄送
Sub fillNsend()
  With objCDO
    .From = """crdotlin""<" & myUserId & "@" & VBA.Mid(mySMTPServer, 6) & ">"
    .To = ActiveSheet.Range("a2").Text
    .Subject = "Test Test"
    .HTMLBody = RangetoHTML(theRng)
    '設定重要性
    '.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
  '處理所有工作表
  For Each Sht In ThisWorkbook.Worksheets
    Sht.Activate '啟動為作用工作表
    '如果A2儲存格式郵件位址, 則將此工作表寄送到該信箱
    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

回復 19# ML089

感謝ML089大的幫忙，終於成功了，叩頭拜謝....