Hi all,
I'm working on a button that can record down the data in the cells and send them as the body in the email through Mozilla Thunderbird, however, my code limitation is only to able to send a row of data for a time, anyone can help to modify my code so that:
-Able to detect the row and identify that it is the rows that latest updated and will record the data(only the latest data) and send as email through Mozilla Thunderbird,
OR
-Screenshot the whole excel page and embed it into the body of the Mozilla Thunderbird and send out as email
This is my excel prototype:
http://www.tiikoni.com/tis/view/?id=2b97413
Below is my code:
Sub Thunderbird_mail()
Dim Toadrs As String, Toadrs1 As String, Toadrs2 As String, Toadrs3 As String, Toadrs4 As String, _
Ccadrs As String, Ccadrs1 As String, Ccadrs2 As String, Ccadrs3 As String, Ccadrs4 As String, kenmei As String, body As String, TimeStart As Double
Toadrs = ThisWorkbook.ActiveSheet.Cells(4, 2) 'Cells(Row number,column number)
Toadrs1 = ThisWorkbook.ActiveSheet.Cells(5, 3)
Toadrs2 = ThisWorkbook.ActiveSheet.Cells(6, 3)
Toadrs3 = ThisWorkbook.ActiveSheet.Cells(7, 3)
Toadrs4 = ThisWorkbook.ActiveSheet.Cells(8, 3)
Ccadrs = ThisWorkbook.ActiveSheet.Cells(9, 3)
Ccadrs1 = ThisWorkbook.ActiveSheet.Cells(10, 3)
Ccadrs2 = ThisWorkbook.ActiveSheet.Cells(11, 3)
Ccadrs3 = ThisWorkbook.ActiveSheet.Cells(12, 3)
Ccadrs4 = ThisWorkbook.ActiveSheet.Cells(13, 3)
kenmei = ThisWorkbook.ActiveSheet.Cells(14, 3) 'Subject
Title_Name = "Name:"
Title_Purpose = "Purpose:"
Title_BookDate = "Book Date:"
Title_TimeStart = "Time Start:"
Title_TimeEnd = "Time End:"
Name = ThisWorkbook.ActiveSheet.Cells(21, 3) 'Name
Purpose = ThisWorkbook.ActiveSheet.Cells(21, 8) 'Purpose
BookDate = ThisWorkbook.ActiveSheet.Cells(21, 20) 'BookDate
TimeStart = ThisWorkbook.ActiveSheet.Cells(21, 21) 'TimeStart
TimeEnd = ThisWorkbook.ActiveSheet.Cells(21, 23) 'TimeEnd
link = Replace(link, "\", "/")
body = Title_Name & Name & "%0a" & Title_Purpose & Purpose & "%0a" & Title_BookDate & BookDate & "%0a" & Title_TimeStart & TimeStart & "%0a" & Title_TimeEnd & TimeEnd & "%0a" ' & "file:///" & link
'body = honbun & "%0a" & "%0a" & link
Call CreateMailByThunderbird(Toadrs, Toadrs1, Toadrs2, Toadrs3, Toadrs4, Ccadrs, Ccadrs1, Ccadrs2, Ccadrs3, Ccadrs4, kenmei, body)
End Sub
Sub CreateMailByThunderbird(Toadrs As String, Toadrs1 As String, Toadrs2 As String, Toadrs3 As String, Toadrs4 As String, _
Ccadrs As String, Ccadrs1 As String, Ccadrs2 As String, Ccadrs3 As String, Ccadrs4 As String, kenmei As String, body As String)
Dim sPath, encodedkenmei
With CreateObject("ScriptControl")
.Language = "JScript"
encodedkenmei = .CodeObject.encodeURI(kenmei)
End With
If Application.OperatingSystem = "Windows (32-bit) NT 6.01" Then
sPath = """C:\Program Files\Mozilla Thunderbird\Thunderbird.exe"" -compose "
Else
sPath = """ C:\Program Files (x86)\Mozilla Thunderbird\Thunderbird.exe"" -compose "
End If
arg = "mailto:" & Toadrs & ";" & Toadrs1 & ";" & Toadrs2 & ";" & Toadrs3 & ";" & Toadrs4 & "?" & _
"cc=" & Ccadrs & ";" & Ccadrs1 & ";" & Ccadrs2 & ";" & Ccadrs3 & ";" & Ccadrs4 & "&" & "subject=" & encodedkenmei & "&" & "body=" & body
Shell sPath & arg
Sleep 1000
CreateObject("Wscript.Shell").SendKeys "^{enter}", True
End Sub
Bookmarks