Appendix Thread 2. ( Codes for other Threads, HTML Tables, etc.)

**DocAElstein** · 06-30-2018, 02:36 PM

Testing codes in support of this Thread
http://www.excelfox.com/forum/showth...0727#post10727

Codes for Alf and sandy666

Code:

Option Explicit
Sub SendfromExcelVBAExpgmail()
Rem 6 EMail send 'For info see:  http://www.excelfox.com/forum/showthread.php/2233-Urgent-support-needed-Multiple-emails-multiple-Excel-workbooks-at-once#post10519
'Working at my end With my With End With Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups)
    '6a(i)
    With CreateObject("CDO.Message") ' -Linking Cods Wollups--------
    Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/"
     .Configuration(LCD_CW & "smtpusessl") = True '
     .Configuration(LCD_CW & "smtpauthenticate") = 1  '
    '  ' Sever info
     .Configuration(LCD_CW & "smtpserver") = "smtp.gmail.com" ' "smtp.office365.com" ' "smtp.live.com" ' "smtp-mail.outlook.com" ' "smtp.live.com" ' "smtp.gmail.com" ' "securesmtp.t-online.de" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com"  "smtp-mail.outlook.com" "smtp.live.com"  "securesmtp.t-online.de"
    '  The mechanism to use to send messages.
     .Configuration(LCD_CW & "sendusing") = 2  '  Based on the LCD_OLE Data Base of type DBTYPE_I4
     .Configuration(LCD_CW & "smtpserverport") = 465 ' 465 or 25 for gmail '587 ' 25  ' 465 or 25 for t-online.de 'or 587 'or 25
    '
     .Configuration(LCD_CW & "sendusername") = "ExcelVBAExp@gmail.com" '
     .Configuration(LCD_CW & "sendpassword") = "xxxxxxxxxxxxxx"       '                                  '
'     .Configuration(LCD_CW & "sendusername") = "YourEMailAddress"
'     .Configuration(LCD_CW & "sendpassword") = "YourEMailPassword"
    ' Optional - How long to try
     .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 '
    ' Intraction protocol is Set/ Updated
     .Configuration.Fields.Update '
    'End With 6a(i)' ----------------------        my Created  LCDCW Library
    '6a(ii) With   ' -- ' Data to be sent---       my Created  LCDCW Library
     Dim strHTML As String: Let strHTML = "<font size=""3"" face=""Calibri"">" & _
     "This is sent from EMail account:" & _
     "<br>Username: ""ExcelVBAExp@gmail.com""" & _
     "<br>Password: ""xxxxxxxxxxxxxxxxxxxxxx""" & _
     "<br><br>" & _
     "<br>Please click on the 5 links below and tell me what happens, thanks!" & _
     "<br>1 <A HREF=""https://app.box.com/s/x01liz3ralbdrt152i52fpwb0wx40ff3"">link to box net cloud free file sharing</A>" & _
     "<br>2 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
     "<br>3 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
     "<br>4 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" & _
     "<br>5 <A HREF=""file:///" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>"
    .To "xxxxxxxxxxxxxx"
    .CC "xxxxxxxxxxxxxa"

    .BCC = ""
    .from = """ExcelVBAExp@gmail.com"" <ExcelVBAExp@gmail.com>"
    .Subject = "Sent from EMail address: ExcelVBAExp@gmail.com"
    .htmlbody = strHTML

    .Send ' Do it
    End With ' 6a(ii) CreateObject("CDO.Message") ---my Created  LCDCW Library
End Sub

Sub SendfromFahrradprinzessinunterwegsgmail()
Rem 6 EMail send 'For info see:  http://www.excelfox.com/forum/showthread.php/2233-Urgent-support-needed-Multiple-emails-multiple-Excel-workbooks-at-once#post10519
'Working at my end With my With End With Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups)
    '6a(i)
    With CreateObject("CDO.Message") ' -Linking Cods Wollups--------
    Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/"
     .Configuration(LCD_CW & "smtpusessl") = True '
     .Configuration(LCD_CW & "smtpauthenticate") = 1  '
    '  ' Sever info
     .Configuration(LCD_CW & "smtpserver") = "smtp.gmail.com" ' "smtp.office365.com" ' "smtp.live.com" ' "smtp-mail.outlook.com" ' "smtp.live.com" ' "smtp.gmail.com" ' "securesmtp.t-online.de" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com"  "smtp-mail.outlook.com" "smtp.live.com"  "securesmtp.t-online.de"
    '  The mechanism to use to send messages.
     .Configuration(LCD_CW & "sendusing") = 2  '  Based on the LCD_OLE Data Base of type DBTYPE_I4
     .Configuration(LCD_CW & "smtpserverport") = 465 ' 465 or 25 for gmail '587 ' 25  ' 465 or 25 for t-online.de 'or 587 'or 25
    '
     .Configuration(LCD_CW & "sendusername") = "Fahrradprinzessinunterwegs@gmail.com" '
     .Configuration(LCD_CW & "sendpassword") = "xxxxxxxxxxxxx"       '                                  '
'     .Configuration(LCD_CW & "sendusername") = "YourEMailAddress"
'     .Configuration(LCD_CW & "sendpassword") = "YourEMailPassword"
    ' Optional - How long to try
     .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 '
    ' Intraction protocol is Set/ Updated
     .Configuration.Fields.Update '
    'End With 6a(i)' ----------------------        my Created  LCDCW Library
    '6a(ii) With   ' -- ' Data to be sent---       my Created  LCDCW Library
     Dim strHTML As String: Let strHTML = "<font size=""3"" face=""Calibri"">" & _
     "This is sent from EMail account:" & _
     "<br>Username: ""Fahrradprinzessinunterwegs@gmail.com""" & _
     "<br>Password: ""xxxxxxxxxxxxxxxxxxx""" & _
     "<br><br>" & _
     "<br>Please click on the 5 links below and tell me what happens, thanks!" & _
     "<br>1 <A HREF=""https://app.box.com/s/x01liz3ralbdrt152i52fpwb0wx40ff3"">link to box net cloud free file sharing</A>" & _
     "<br>2 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
     "<br>3 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
     "<br>4 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" & _
     "<br>5 <A HREF=""file:///" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>"
    .To "xxxxxxxxxxxxxxxxxxxx"
    .CC "xxxxxxxxxxxxxxxxxxx"
    .BCC = ""
    .from = """Fahrradprinzessinunterwegs@gmail.com"" <Fahrradprinzessinunterwegs@gmail.com>"
    .Subject = "Sent from EMail address: Fahrradprinzessinunterwegs@gmail.com"
    .htmlbody = strHTML

    .Send ' Do it
    End With ' 6a(ii) CreateObject("CDO.Message") ---my Created  LCDCW Library
End Sub



Sub SendfromDocAlnsteinGermanTelekom()
Rem 6 EMail send 'For info see:  http://www.excelfox.com/forum/showthread.php/2233-Urgent-support-needed-Multiple-emails-multiple-Excel-workbooks-at-once#post10519
'Working at my end With my With End With Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups)
    '6a(i)
    With CreateObject("CDO.Message") ' -Linking Cods Wollups--------
    Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/"
     .Configuration(LCD_CW & "smtpusessl") = True '
     .Configuration(LCD_CW & "smtpauthenticate") = 1  '
    '  ' Sever info
     .Configuration(LCD_CW & "smtpserver") = "securesmtp.t-online.de" ' "smtp.gmail.com" ' "smtp.office365.com" ' "smtp.live.com" ' "smtp-mail.outlook.com" ' "smtp.live.com" ' "smtp.gmail.com" ' "securesmtp.t-online.de" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com"  "smtp-mail.outlook.com" "smtp.live.com"  "securesmtp.t-online.de"
    '  The mechanism to use to send messages.
     .Configuration(LCD_CW & "sendusing") = 2  '  Based on the LCD_OLE Data Base of type DBTYPE_I4
     .Configuration(LCD_CW & "smtpserverport") = 465 ' 465 or 25 for gmail '587 ' 25  ' 465 or 25 for t-online.de 'or 587 'or 25
    '
     .Configuration(LCD_CW & "sendusername") = "Doc.Alnstein@t-online.de" '
     .Configuration(LCD_CW & "sendpassword") = "xxxxxxxxx"       '                                  '
'     .Configuration(LCD_CW & "sendusername") = "YourEMailAddress"
'     .Configuration(LCD_CW & "sendpassword") = "YourEMailPassword"
    ' Optional - How long to try
     .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 '
    ' Intraction protocol is Set/ Updated
     .Configuration.Fields.Update '
    'End With 6a(i)' ----------------------        my Created  LCDCW Library
    '6a(ii) With   ' -- ' Data to be sent---       my Created  LCDCW Library
     Dim strHTML As String: Let strHTML = "<font size=""3"" face=""Calibri"">" & _
     "This is sent from EMail account:" & _
     "<br>Username: ""Doc.Alnstein@t-online.de""" & _
     "<br>Password: ""xxxxxxxxxxx""" & _
     "<br><br>" & _
     "<br>Please click on the 5 links below and tell me what happens, thanks!" & _
     "<br>1 <A HREF=""https://app.box.com/s/x01liz3ralbdrt152i52fpwb0wx40ff3"">link to box net cloud free file sharing</A>" & _
     "<br>2 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
     "<br>3 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
     "<br>4 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" & _
     "<br>5 <A HREF=""file:///" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>"
    .To "xxxxxxxxxxxxxxxxxxxxxxxx"
    .CC "xxxxxxxxxxxxxxxxxxxxxxxxx"

    .BCC = ""
    .from = """Doc.Alnstein@t-online.de"" <Doc.Alnstein@t-online.de>"
    .Subject = "Sent from EMail address: Doc.Alnstein@t-online.de"
    .htmlbody = strHTML

    .Send ' Do it
    End With ' 6a(ii) CreateObject("CDO.Message") ---my Created  LCDCW Library
End Sub

Instructions:
Three files are attached. Please download them and store them all somewhere on your computer. They can be stored anywhere, but important is that they are all stored in the same Folder :
All 3 files stored in same place.JPG : https://imgur.com/rFu0TML

Please open only one file “Test File xxxx to send EMail containing Hyperlinks to Files.xlsm”
Enable macros.

There are three codes in file “Test File xxxx to send EMail containing Hyperlinks to Files.xlsm”.
The codes are very similar, differing only in the Email account used as the .Sender:
Sub SendfromDocAlnsteinGermanTelekom()
Sub SendfromFahrradprinzessinunterwegsgmail()
Sub SendfromExcelVBAExpgmail()

Please try to run those codes.
Each code should send you an Email which on arrival will look something similar to this:
Typical received EMail.JPG : https://imgur.com/4oNXNtW

Please click on the 5 Hyperlinks and tell me what happens.

My final goal is to get a Hyperlink which when clicked opens an Excel or Word File.
I have tested the codes sending to my gmail and German Telekom Email accounts.
But so far, only link 1 works. But link 1 does not open a file: It simply sends you to a file sharing site. So link 1 is a temporary solution for me.

Code for Thai in next post....