Pulling ListBox Data, Text and HTMLrange as Email Body - excel

So I will try and be as clear as possible.
I am trying to make a macro that will populate and email with the following things:
Values from Listboxes
Writing for the main message
and a Table of values (which I've currently got being populated as a HTML body.
For example, I would like the email body to look as follows:
"Dear" [Name from preselected listbox]
"In order that we compile the latest update for the NAV please can you arrange the following information to be provided for" [The date]
[LIST THROUGH HTML]
"Please can you provide this information by the folowinf date"/....
I've currently got the list being pulled through correctly, but that has then stopped the vba body being entered. Therefore, the following code only pulls through the list.
Dim Addressee As String, SenRan As Range ' Define the receipient as words
Addressee = Application.VLookup(SourceLiBo.Value, Sheet1.Range("A1:B1000"), 2, False) 'finds the email address for chosen name
Set SenRan = ThisWorkbook.Sheets("Assets").Range("A1").CurrentRegion 'Selects the range of assets to be emailed.
With OEmail
.To = Addressee 'Send to addressee
.Subject = "Information Request " & Format(Date, "mmmm")
.Body = "Dear " & Me.SourceLiBo & "," & Chr(10) & _
"In order that we can compile the latest update for the NAV, please can you arrange the following information to be provided for " & Format(Date, "mmmm") & ":" & Chr(10) & _
""
.HTMLBody = rangetoHTML(SenRan)
End With
How is the best way to go about this in order to have all the data pull through. I would set variables with the strings wanted for the body and input it through .HMTLBody, but would that also allow me to pull through th listbox values in HMTLBody

I have now reworded it, thanks to braX explaining my errors. The code below (with the Ron Bruin Function) provides the correct answer.
With OEmail
.To = Addressee 'Send to addressee
.Subject = "Information Request " & Format(Date, "mmmm")
.HTMLBody = "Dear " & Me.SourceLiBo & "," & _
"<br><br>" & _
"In order that we can compile the latest update for the NAV, please can you arrange the following information to be provided for " & Format(Date, "mmmm") & ":" & _
"<br><br>" & _
rangetoHTML(SenRan) & _
"<br><br>" & _
"Please let us know if there are any additional purchases not reflected in the list above." & _
"<br><br>" & _
"Please can you provide this information no later than 10 working days from the date of this email to allow us to process all updates for delivery." & _
"<br><br>" & _
"Many Thanks"
End With

Related

Add file link to email body VBA

I'd like to add a network file link to my email body using Excel VBA.
The code below add the text, but I'd like file location to be a hyperlink?
strbody_2 = "<BODY style=font-size:11pt;font-family:Calibri><b><u>" & "CapAd File:" & "</b><u>" & "<br>" _
& Sheets("Control").Range("CapAd_File") _ ' THIS IS THE FILE LOCATION
& "</b></u>"
try using the html <a>-Anchor tag:
strbody_2 = "<BODY style=font-size:11pt;font-family:Calibri><b><u>" & "CapAd File:" & "</b><u>" & "<br>" _
& "<a href=""" & Sheets("Control").Range("CapAd_File") & """>" _
& Sheets("Control").Range("CapAd_File") _ ' THIS IS THE FILE LOCATION
& "</a></b></u>"
(sorry if i didn't get the apostrophies correct i didn't test it before i posted)

.Body will not compile but quote and new line brackets seem correct

I am playing with a script that sends emails from an excel sheet. the body of my email is not compiling. However I have wrapped everything in "" with & _ breaks for when it goes too far and .value _ & vbNewLine & _ for line breaks
I have tried annotating out chunks of the email body to fish out the syntax error
.Body = "Hello " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"this is Paul from the XYZ and I just left you a voicemail message for you. " & _
"We are reaching out to you because you’ve been identified in the XYZ system as someone who manages XYZ " & _
"The XYZ form, which you have been using, will be retired after XYZ and be replaced with a new process and system. " & _
"If you onboard XYZ for your organization, this means you will be directly impacted. " & _
"We need to collect your information to set you up in our new system and ensure there is no interruption moving forwards. " & _
"We will reach out again and if you can please provide the following information below: ".Value _
& vbNewLine & vbNewLine & _
"Best email to contact you: ".Value _
& vbNewLine & _
"Best phone number to reach you: ".Value _
& vbNewLine & _
"Best time of day to schedule our next call: ".Value _
& vbNewLine & vbNewLine & _
"If you have any questions or concerns, please don’t hesitate to reach out directly to me at XYZ ".Value _
& vbNewLine & vbNewLine & _
"Thank you, "
Email should go out. But instead I get a syntax error compile error
"Best email to contact you: ".Value _
There's the error. That .Value member call is illegal, a string literal doesn't have members. You probably mean to be doing this:
"Best email to contact you: " & .Value _
Same here:
"Best phone number to reach you: ".Value _
And here:
"Best time of day to schedule our next call: ".Value _
And here too:
"We will reach out again and if you can please provide the following information below: ".Value _
Now, the inconsistency of whether you put the & at the end or at the start of a line, makes the code extremely hard to parse. Decide whether you want it at the end or at the beginning, and stick to it.

Is there any reason a VBA sub would stop working only on my PC?

I have a function (bastardised from Ron DeBruin's Website) that saves the active or selected sheet as a pdf and sends it as an attachment in outlook. It still works for everyone I've given it to but lately, it is not working on my PC. I keep getting the error message as if VBA cannot save the file (due to the path being invalid or the name being used already and not wanting to overwrite)
Running on various PCs that are either running on Windows 10 or 7 (I'm on Win10) I've tried changing the save file path & the filename in the code to something more simple and I still have the same issues. I tried the file on another machine running windows 10 and had no issues. I've also tried checking Microsoft Add-Ins and everything is fine.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RDB_Worksheet_Or_Worksheets_To_PDF_And_Create_Mail()
Dim FileName As String
If ActiveWindow.SelectedSheets.Count > 1 Then
MsgBox "There is more than one sheet selected," & vbNewLine & _
"be aware that every selected sheet will be published"
End If
'Call the function with the correct arguments
'Tip: You can also use Sheets("YourSheetName") instead of ActiveSheet in the code(sheet does not have to be active then)
FileName = RDB_Create_PDF(Source:=ActiveSheet, _
FixedFilePathName:="C:\Users\" & Environ("Username") & "\Documents\Container Shipment Reports\" & (Range("G4").Value) & ".pdf", _
OverwriteIfFileExist:=True, _
OpenPDFAfterPublish:=False)
'For a fixed file name use this in the FixedFilePathName argument
'FixedFilePathName:="C:\Users\Ron\Test\YourPdfFile.pdf"
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
StrTo:="XXXXXX.XXXXXXX#XXXXX.com.au", _
StrCC:="XXXXXX.XXXXXXX#XXXXX.com.au; XXXXXX.XXXXXXX#XXXXX.com.au", _
StrBCC:="", _
StrSubject:="Container Shipment Report " & (Range("G4").Value) & ".", _
Signature:=True, _
Send:=False, _
StrBody:="<body>Hello,</body><br>" & _
"<body>Please see the attached Container Shipment Report# " & (Range("G4").Value) & " from " & (Range("E4").Value) & "." & _
"<br><br>" & "Thank you.</body>"
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
"The path to Save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exists"
End If
Application.Quit
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
This should convert to PDF, attach to an email, send the email and then close Excel. At the moment I am just getting the MsgBox response from the code, "Not possible to create PDF, possible reasons: etc".
(there is also a function to stop the excel file saving as it is meant to be a blank template.) As I said this seems to be an issue only on my machine but as it works on other computers I'm thinking there's no issue with the code.

Update a table data link in AutoCAD using VBA

I have an issue, have an AutoCAD file with a ton of data links and would like to update only the data links related to a speciffic table.
Simmilar to the functionality of selecting a table with data links, right clicking and selecting Update Table Data Links.
i have the following code:
Private Sub Update_table_data_link(tblRef As AcadTable)
ThisDrawing.SendCommand "DATALINKUPDATE" & vbCr & "U" & vbCr & "K" & vbCr
End Sub
It works but updates all the data links in the drawing (which is a problem) so a perfect solution would either let me get what links are associated to tblRef
and change the line to:
ThisDrawing.SendCommand "DATALINKUPDATE" & vbCr & "U" & vbCr & "D" & vbCr & "datalink_name_from_tblRef" & vbCr
or directly send the command to update the links to tblRef
After much digging around and a lot of help, here is the answer:
Private Sub Update_table_data_link(tblRef As AcadTable)
ThisDrawing.SendCommand "DATALINKUPDATE " & vbCr & "U" & vbCr & Ent2lspEnt(tblRef) & vbCr & vbCr
End Sub
Public Function Ent2lspEnt(entObj As AcadEntity) As String
'Designed to work with SendCommand, which can't pass objects.
'This gets an objects handle and converts it to a string
'of lisp commands that returns an entity name when run in SendCommand.
Dim entHandle As String
entHandle = entObj.Handle
Ent2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function
note that "Update_table_data_link" has a table as input

VBA: Send Email via IBM Notes, Add Signature?

I have the following vba code, which runs from Excel. It sends an email to a list of recipients in a range.
Sub Send_Email()
Dim answer As Integer
answer = MsgBox("Are you sure you want to Send All Announcements?", vbYesNo + vbQuestion, "Notice")
If answer = vbNo Then
Exit Sub
Else
Dim rnBody As Range
Dim Data As DataObject
Set rnBody = Worksheets(1).Range("N3")
rnBody.Copy
Dim Maildb As Object
Dim MailDoc As Object
Dim Body As Object
Dim Session As Object
Dim i As Long
Dim j As Long
Dim server, mailfile, user, usersig As String
Dim LastRow As Long, ws As Worksheet
LastRow = Worksheets(1).Range("F" & Rows.Count).End(xlUp).Row 'Finds the last used row
j = 18
'Start a session of Lotus Notes
Set Session = CreateObject("Lotus.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
Call Session.Initialize
'Open the Mail Database of your Lotus Notes
user = Session.UserName
usersig = Session.CommonUserName
server = Session.GetEnvironmentString("MailServer", True)
mailfile = Session.GetEnvironmentString("MailFile", True)
Set Maildb = Session.GetDatabase(server, mailfile)
If Not Maildb.IsOpen = True Then Call Maildb.Open
With ThisWorkbook.Worksheets(1)
For i = 18 To LastRow
'Create the Mail Document
Session.ConvertMime = False ' Do not convert MIME to rich text
Set MailDoc = Maildb.CREATEDOCUMENT
Call MailDoc.ReplaceItemValue("Form", "Memo")
'Set From
Call MailDoc.ReplaceItemValue("Principal", "Food.Specials#Lidl.co.uk")
Call MailDoc.ReplaceItemValue("ReplyTo", "Food.Specials#Lidl.co.uk")
Call MailDoc.ReplaceItemValue("DisplaySent", "Food Specials")
Call MailDoc.ReplaceItemValue("iNetFrom", "Food.Specials#Lidl.co.uk")
Call MailDoc.ReplaceItemValue("iNetPrincipal", "Food.Specials#Lidl.co.uk")
'Set the Recipient of the mail
Call MailDoc.ReplaceItemValue("SendTo", Range("Q" & i).value)
'Call MailDoc.ReplaceItemValue("CopyTo", "food.specials#lidl.co.uk")
'Set subject of the mail
Call MailDoc.ReplaceItemValue("Subject", "Promotion Announcement for week " & Range("I8").value & ", " & Range("T8").value & " - Confirmation required")
'Create and set the Body content of the mail
Set Body = MailDoc.CREATERICHTEXTITEM("Body")
If Range("I10").value <> "" Then
Call Body.APPENDTEXT("Good " & Range("A1").value & "," & vbNewLine & vbNewLine _
& "Please see attached an announcement of the spot buy promotion for week " & Range("I8").value & ", " & Range("T8").value & "." & vbNewLine & vbNewLine _
& "Please can you confirm within 24 hours." & vbNewLine & vbNewLine _
& Range("I10").value & vbNewLine)
Else
Call Body.APPENDTEXT("Good " & Range("A1").value & "," & vbNewLine & vbNewLine _
& "Please see attached an announcement of the spot buy promotion for week " & Range("I8").value & ", " & Range("T8").value & "." & vbNewLine & vbNewLine _
& "Please can you confirm within 24 hours." & vbNewLine)
End If
'Embed Excel Sheet Range
Set Data = New DataObject
Data.GetFromClipboard
Call Body.ADDNEWLINE(2)
Call Body.EmbedObject(1454, "", Range("F" & i).value, "Attachment")
'create an attachment (optional)
Call Body.ADDNEWLINE(3)
Call Body.APPENDTEXT(Data.GetText)
'create an attachment (optional)
Call Body.ADDNEWLINE(4)
Call Body.APPENDTEXT(Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0))
'Example to save the message (optional) in Sent items
MailDoc.SaveMessageOnSend = True
'Send the document
'Gets the mail to appear in the Sent items folder
Call MailDoc.ReplaceItemValue("PostedDate", Now())
Call MailDoc.Send(False)
Set MailDoc = Nothing
j = j + 1
Next i
End With
'Clean Up the Object variables - Recover memory
Set Maildb = Nothing
Set Body = Nothing
Set Session = Nothing
Application.CutCopyMode = False
MsgBox "Success!" & vbNewLine & "Announcements have been sent."
End If
End Sub
The code semi works. Emails are sent fine.
However, i want to be able to add the default signature to the bottom of my email. I am trying to do this using this line but its not adding any signature.
'create an attachment (optional)
Call Body.ADDNEWLINE(4)
Call Body.APPENDTEXT(Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0))
My signature contains an image, and i'm wondering if this won't pull through the signature because my email isn't html?
In which case then, how could i change this email to html?
Please can someone show me what i am doing wrong?
Your suspicion is correct. This won't work since you're creating a Notes rich text email message - but the solution is not necessarily switching to creating a MIME/HTML message. The NotesRichTextItem class's AppendText method can only handle text, but if the Notes signature is in rich text format, it's actually the Signature_Rich item that you should be working with, not the Signature item, and you should be using the AppendRTItem method instead of the AppendText method.
The truth is, though, that with two different mail formats and several different options for the way the signature is managed in the user's profile, this is a non-trivial problem to handle for all of the different cases that you might have to handle. You really have to look at the SignatureOption item value, which is "3" if it is rich text, "2" if it's an HTML or image file, and "1" if it is plain text. The solution in your code is going to be different depending on which one is being used, and coping with option 2 while creating a rich text message isn't going to be easy.
You might want to check out the answer to this previous question for an example of building a MIME message if you want to get away from using Notes rich text. And while I haven't vetted the code in this blog post, it shows appending a signature - it looks like it is assuming that the signature is in a file rather than checking the SignatureOptions item.

Resources