Send an email with signature in VBA - vba

I try to ask my questions here 'cause I don't find any answer to my problems anywhere.
I try to send an email in vba from my excel using outlook signature but I get a 62 error.
This is the code I used, that works fine in another Excel worksheet and works fine in it, but not in my other worksheet.
Dim FSO As Scripting.FileSystemObject
Dim TextStream As Scripting.TextStream
Dim file_name As String
dim signature_name as string
dim signature as string
signature_name = Sheets("Parameter").Range("A2").Value
signature = ""
Set FSO = Nothing
Set TextStream = Nothing
Set FSO = New Scripting.FileSystemObject
file_name = Environ("APPDATA") & "\Microsoft\Signatures\" & signature_name & ".htm"
Set TextStream = FSO.OpenTextFile(file_name, ForReading, False, TristateMixed)
If Err.Num = 0 Then
signature = TextStream.ReadAll
signature = Replace(signature, signature_name & "_files/", Environ("APPDATA") & "\Microsoft\Signatures\" & signature_name & "_files/")
End if
I checked with checkpoint what file_name contained and it contained the right path to the signature files.
But still, when I try to OpenTextFile, I get an atEndOfLine = true and atEndOfStream = true
I hope you guys could help me 'cause I get stuck since two weeks on this problem :D
Thanks for your time
H.
I try checkpoint, debugging, différents signature, copy/paste several codes
When I check the err.num value, it returns me 438...

I was having trouble getting my signature from "\Microsoft\Signatures\" or whatever address I was using. Something to do with the server I was on.
Anyway, I found this solution and it's been working for me consistently (as long as it's only your "default" signature you want:
Sub Build_And_Send_Email()
Dim objOutlook As Object
Dim objEmail As Object
Dim objAttachment As Object
`...
'Setup Email
Set objOutlook = CreateObject("Outlook.Application")
Set objEmail = objOutlook.CreateItem(olMailItem)
'when displayed with no content, it inputs default signature
objEmail.Display
Set objAttachment = objEmail.Attachments
objAttachment.Add "S:\Attachment Directory.pdf"
eSubject = " My Subject "
eBody = " Some text using html control for stuff like <br> line breaks "
'Build Email
With objEmail
.To = eRecipient
.CC = ""
.BCC = ""
.Subject = eSubject
' > Signature already included in .HTMLBody
.HTMLBody = eBody & .HTMLBody
.BodyFormat = olFormatHTML ' send plain text message
'.Display
'.Send
End With
End Sub
I use this everyday for multiple reports. Seems to work on multiple computers. I hope it works for you.

Related

Can I create and save a signature as default in Outlook through VBA?

I have made some progress and hence editing my description
I have a .xls file with signature that user save.
User clicks a custom button which opens a FileDialog from where he searches and selects the signature file. The code extracts the signature from the xls file and creates an HTML file in "AppData/Roaming/Microsoft/Signatures". My code works uptill this part--it opens the file and extracts the signature portion, creates HTML, the signature option is visible in the Signature Menu in Outlook. But when i click the mode-generated signature option, it is not displayed in the mail body.
I compared it with a manually created Signature in Outlook and after comparing the 2 HTML files, I feel this portion is causing the problem.
The marked portion is in the manually created signature but not in my code generated one. My inference is I am not creating a signature type HTML file as such. Can anyone help me with this? And my initial question still remains how do I make my code generated signature the default one?
My Code is as follows:
Option Explicit
Public Sub MailSignatur2()
Dim SigFolder2 As String
Dim fd As Office.FileDialog
Dim selectedItem As Variant
Dim SigFolder As String
Dim ExcelFileName As String
Dim FileName As String
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Dim Signature As String
Dim oMsg As MailItem
Dim c As Variant
Dim fso As New FileSystemObject
Dim saveFolder As String
Dim DateFormat As String
Dim objSign As MailItem
SigFolder2 = "C:\Users\" & Environ("UserName") & "\Downloads\"
Debug.Print SigFolder2
Set fd = objExcel.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.InitialFileName = SigFolder2
.AllowMultiSelect = False
.Title = "Select Signature File"
End With
If fd.Show = -1 Then
For Each selectedItem In fd.SelectedItems
SigFolder = selectedItem
Next
Else
Exit Sub
End If
ExcelFileName = SigFolder
FileName = Left(fso.GetFileName(ExcelFileName), InStr(fso.GetFileName(ExcelFileName), ".") - 1)
Debug.Print ExcelFileName
Debug.Print FileName
Set exWb = objExcel.Workbooks.Open(ExcelFileName)
Signature = vbNullString
For Each c In exWb.Sheets(FileName).Range("A1:A30")
If c.Value = "$" Then
Exit For
Else
If c.Value = "%" Then
Signature = Signature & "<hr align='left' width='20%'><br>"
Else
Signature = Signature & c.Value & "<br>"
End If
End If
Next c
On Error Resume Next
Set oMsg = ActiveInspector.CurrentItem
On Error GoTo 0
Set objSign = Application.CreateItem(olMailItem)
With objSign
.HTMLBody = "<html><body><div><p>" & Signature & "</p></div></body></html>"
End With
saveFolder = "C:\Users\" & Environ("UserName") & "\AppData\Roaming\Microsoft\Signatures\"
objSign.SaveAs saveFolder & "Official_Sign.html", olHTML
Debug.Print saveFolder
ExitRoutine:
Set oMsg = Nothing
Set exWb = Nothing
Set objExcel = Nothing
End Sub
Got it. Very small mistake.It should be .htm instead of .html
objSign.SaveAs saveFolder & "Official_Sign.htm", olHTML

Not able to add image in outlook body

I'm using outlook 2016 and Excel 2016. I have written a code to paste a email in the outlook body. My email body contains html codes which has image included,the code works fine however I'm not able to paste the image in the email body. Please help.
Please find the vba code below.
Sub Send_Mails()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim subj As String
Dim recp As String
Dim bccrep As String
Dim ccrecp As String
Dim i As Integer
For i = 2 To 10
Sheets("Email Draft").Select
strbody = Sheets("Email Draft").Range("C1")
subj = "Welcome - " & Sheets("Macro").Range("O" & i)
recp = Sheets("Macro").Range("I" & i)
ccrecp = Sheets("Macro").Range("J" & i)
bccrep = Sheets("Macro").Range("K" & i)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = recp
.CC = ccrecp
.BCC = bccrep
.Subject = subj
.HTMLBody = .HTMLBody & strbody
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
Next i
End Sub
If you appending HTML to the existing HTML message body you are likely adding content outside of the element and it won't be visible. You have to modify what is in the element. As an alternative to manipulating the HTML string, you can use the Word Object Model to change the body content via Inspector.WordEditor.

Outlook VBA macro for multiple file attachment according to filename string

I have a working macro for Outlook wherein it will create new email.
However, I need some several files that are needed to be attached from a specific local folder and the files attached always has current date on the file naming (FILE1_ddmmyyyy).
Example: FILE1_30102018.xlsx, FILE2_30102018.xlsx
Below is the code I have right now and I can't figure out how to auto-attach the files with the filename "*30102018.xlsx"
Sub FileDraft()
Dim obApp As Object
Dim NewMail As MailItem
'Format(Date, "ddmmyyyy")
Dim szTodayDate As String
szTodayDate = Date
Dim szNextDate As String
Dim LWeekday As Integer
LWeekday = Weekday(szTodayDate, vbSunday)
If LWeekday = "5" Then
szNextDate = DateAdd("d", 3, szTodayDate)
Else
szNextDate = DateAdd("d", 1, szTodayDate)
End If
Dim szNextDatereformat As String
szNextDatereformat = Format(szNextDate, "ddmmyyyy")
Set obApp = Outlook.Application
Set NewMail = obApp.CreateItem(olMailItem)
'You can change the concrete info as per your needs
With NewMail
.Subject = "FILES_" & szNextDatereformat
.To = "Recipient_Address"
.CC = "contacts_on_the_CC"
.Body = "messageBodyhere"
.Attachments.Add ("C:\Attachments\FILE1_30102018.xlsx")
.Importance = olImportanceHigh
.Display
End With
Set obApp = Nothing
Set NewMail = Nothing
End Sub
To get a list of files in VBA using wildcards, you can use the Dir command.
When calling Dir with a parameter, a new search will start, using the parameter as file name pattern (very similar to issuing a Dir at the command prompt). It returns the name of a file that matches the name (without the path).
When calling Dir without parameter, it will continue the search and return the next file. When no (more) files are found, the empty string is returned.
So, change your code like
Const path = "C:\Attachments\"
With NewMail
...
dim pattern As String, fileName As String
pattern = path & "*" & szNextDatereformat & ".*"
fileName = Dir(pattern)
Do While fileName <> ""
.Attachments.Add path & fileName
fileName = Dir
Loop
...
end With

Cannot run my codes for sending email in other machine

I am helping my friend to develop her codes using VBA. I have successfully run these codes in my laptop yet she is encountering errors when we copy the codes to her machine.
Here's my code:
Sub Test()
Call sendingEmailWithChecklist("Book1.xlsm")
End Sub
Sub sendingEmailWithChecklist(workbookName As String)
Dim recipient As String
Dim cc As String
Dim subject As String
Dim body As Range
Dim greetings As String
Dim message As String
Dim signature As String
Dim ebody As String
Dim olApp As Outlook.Application
Dim olInsp As Outlook.Inspector
Dim wdDoc As Word.Document
Dim olEmail As Outlook.MailItem
Dim worksheetName As String
Dim content As Range
Set olApp = New Outlook.Application
Set olEmail = olApp.CreateItem(olMailItem)
Sheet2.Activate
recipient = Range("B3").Value
cc = Range("B4").Value
subject = Range("B5").Value
greetings = Range("B6").Value
message = Range("B7").Value
ebody = greetings & vbNewLine & vbNewLine & message & vbNewLine
signature = Range("B8").Value
'Workbooks(workbookName).Activate
worksheetName = "Sheet1"
With olEmail
.Display
.To = recipient
.cc = cc
.subject = subject
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Workbooks(workbookName).Worksheets(worksheetName).Activate
Workbooks(workbookName).Worksheets(worksheetName).Cells.Copy
'Range("A1:F17").Select
'Selection.Copy
End With
With olEmail
.Display
wdDoc.Range(1, 1).Paste
wdDoc.Range.InsertBefore ebody
'.Send
End With
End Sub
wdDoc.Range(1,1).Paste was her error. We have both declared same references from tools yet the error is still on this line. What could be the possible error why it doesn't run on her machine?
PS. She doesn't want to use HTMLbody.
Instead of
wdDoc.Range(1, 1).Paste
Try
wdDoc.Range.Paste
If you want to further control the way you paste your data in the body of mail you may want to use the Word Selection object (expression) instead of Range. Something like:
wdDoc.Application.Selection.PasteAndFormat wdFormatOriginalFormatting
Above paste the copied item with its original formatting. You may select other PasteAndFormat options depending on your expected outcome.

Excel VBA to Outlook: error Type Mismatch

I am trying to write a VBA code in Excel that will create an Outlook message which contains:
text in the body
a table
a signature at the bottom.
Below is a code that I wrote. It was working until I added the Excel Table object to the body of the message. It's coming up with an error message that says:
Run-time error: error type 13, Type Mismatch".
Can someone help with my code below?
Sub send()
Dim OApp As Object, OMail As Object, signature As String
Dim TOEMAIL As Range
Dim CCMEMAIL As Range
Dim SUBJECT As Range
Dim Workbook As Range
Dim Table As Range
Set TOEMAIL = Sheets("Macro").Range("D6")
Set CCEMAIL = Sheets("Macro").Range("D7")
Set SUBJECT = Sheets("Macro").Range("D8")
Set Workbook = Sheets("Macro").Range("D5")
Set Table = Sheets("Sheet1").Range("B7:B17")
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
With OMail
.Display
End With
signature = OMail.body
With OMail
.To = TOEMAIL
.CC = CCEMAIL
.SUBJECT = SUBJECT
.Attachments.Add (Workbook)
.body = "Hello, this is a test." & vbNewLine & Table & vbNewLine & signature & vbNewLine
End With
Set OMail = Nothing
Set OApp = Nothing
End Sub
MailItem.Body property expects a string. You are trying to concatenate a few strings and a Range object. It is your responsibility to extract the relevant data from that table and represent it as a string.
You would probably be better off creating an HTML table and setting the MailItem.HTMLBody property instead.