Board logo

標題: 儲存格超連結電子郵件設定 [打印本頁]

作者: takeshilin88    時間: 2016-2-24 17:13     標題: 儲存格超連結電子郵件設定

請問各位大大:
想在EXCEL的儲存格中設定超連結,
超連結中的電子郵件設定->主旨  ,想要自動顯示民國年月。
也就是說設定好之後,只要點該儲存格,會自動建立電子郵件,
且電子郵件的「主旨」欄位會自動顯示目前的民國年份及月份,EX: 自動抓取105年2月份,所以顯示105-2
請各位大大幫幫忙,謝謝
作者: yen956    時間: 2016-2-24 19:40

你的意思是不是欄A(如A2)輸入"主旨A",
則欄B(如B2)出現 "主旨A 105年2月" ?
如果是, 試試:
B2=IF(A2="","",A2&" "&TEXT(NOW(),"e年m月")) 下拉
作者: 准提部林    時間: 2016-2-24 22:08

用超連結發送Email
[attach]23320[/attach]

[attach]23321[/attach]
作者: yen956    時間: 2016-2-25 05:06

本帖最後由 yen956 於 2016-2-25 05:07 編輯

謝謝准大, 好東西要好好的收藏, 謝謝!!
(建議另放分享)
作者: takeshilin88    時間: 2016-2-25 08:38

目前還是小學生(努力升等中),
還不能下載附件,
不過還是很謝謝准大的回答,
感恩~~
作者: 准提部林    時間: 2016-2-25 10:02

回復 5# takeshilin88

另一下載址:
http://www.funp.net/715484
作者: ML089    時間: 2016-2-25 14:07

回復 3# 准提部林

我使用OUTLOOK 寄件人分隔符號為分號  ;

請問 附件 要如何設定,我使用下列方式無法成功,哪裡要修改? 還是OUTLOOK方法不同?
=HYPERLINK("mailto:"&A2&"?subject="&B2&"&body="&SUBSTITUTE(C2,CHAR(10),"%0A") & "&attachment=D:\TEST.TXT" , "發信")
作者: 准提部林    時間: 2016-2-25 18:11

回復 7# ML089


SUBSTITUTE(C2,CHAR(10),"%0A") 是將〔換行符號〕取代成"%0A"
若以以";"為分隔,則為SUBSTITUTE(C2,";","%0A")!
作者: takeshilin88    時間: 2016-2-26 08:42

回復 6# 准提部林


    [attach]23336[/attach]

准大您好:
感謝您提供的下載網址~~
若是已在編輯超連結/電子郵件地址,已設定好mail信箱,
1.那該儲存格的公式HYPERLINK是否可以不加mailto?
2.還是可以直接在編輯超連結//電子郵件地址/主旨裡,直接設定公式呢?
謝謝~
作者: 准提部林    時間: 2016-2-26 09:46

本帖最後由 准提部林 於 2016-2-26 09:47 編輯

回復 9# takeshilin88

只要〔主旨〕
=HYPERLINK("mailto:?subject="&B2, "發信")

一般的超連結,應無法設公式吧!
作者: takeshilin88    時間: 2016-2-26 09:58

回復 10# 准提部林

謝謝准大~~
感激不盡~~~~
作者: takeshilin88    時間: 2016-2-26 18:38

回復 10# 准提部林


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

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

    感恩~~
作者: 准提部林    時間: 2016-2-26 18:52

回復 12# takeshilin88


什麼意思?舉個例子?
作者: takeshilin88    時間: 2016-2-26 19:08

回復 13# 准提部林

[attach]23338[/attach]

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

    可以改成這樣嗎?
    1.當按下D2儲存格的「發信」之後,
    2.EXCEL自動複製A2:D2,
    3.自動開啟新郵件(收件者、主旨自動產生)

    接下來我只要直接到新郵件的內容,按「貼上」,就能把A2:D2的表格貼到新郵件內容中,
    按下D3儲存格亦同,會自動複製A3:D3
   
    這樣不曉得准大了解我的意思了嗎?

    謝謝~~
作者: 准提部林    時間: 2016-2-26 21:19

回復 14# takeshilin88

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

這樣除收件人及主旨外,內文是空的,
也許試著了解公式原理,再自行嚐試去套看看吧!
作者: takeshilin88    時間: 2016-3-1 17:29

回復 15# 准提部林


准大您好:

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

回復 16# takeshilin88

=HYPERLINK("mailto:"&A2&"?subject="&B2&"&body="&L2:N3, "發信")
改為
=HYPERLINK("mailto:"&A2&"?subject="&B2&"&body="&L2&"%0A"&M2&"%0A"&N2&"%0A", "發信")
作者: takeshilin88    時間: 2016-3-2 08:49

回復 17# ML089

ML089大您好:

謝謝您的提供的公式,已經可以把想要的範圍貼到新郵件內文中了,
另外請教,有辦法連EXCEL範圍中的格式一併貼到內文嗎?
因為想用如圖中薪資袋的表格貼到新郵件內文中,
感激不盡~~
[attach]23358[/attach]
作者: ML089    時間: 2016-3-2 11:00

回復 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    時間: 2016-4-1 08:35

回復 19# ML089

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




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)