Here’s a quick video of a machine I’m working on. It folds and irons a strip of fabric, similar to this machine: “Simplicity Bias Tape Maker“.
It’s functioning nicely, I just want to add an insulated handle to the top to prevent burns. The heating element is well insulated, the body doesn’t heat up with the exception of the two bolts that hold the floating top plate on… which will definitely burn you.
The temperature is variable and has closed loop control. Motor speed is also adjustable, in the video I have it running fairly slow. As you can see I’m not great with textiles, so my strip isn’t very consistent and has some big lumps at the seams.
Here is an example application for some of the functions I have posted previously. This sheet will take a list of recipients as an input and generate an Outlook email for each. This came about when a colleague of mine was using the traditional mail merge in office for the first time and ran into a roadblock trying to add a CC to each message. I am not an expert with mail merge, but when I looked around the first search results suggested using a rule in Outlook as a workaround. Here’s my workaround and what it does:
Variables in the email body/subject can be entered in a similar way to mail merge, using this format <<variable>>. Just like a mad-lib.
The same attachment can be added to each message, or a unique attachment can be added for each entry on the list
Multiple recipients are added to the list by separating them with a semicolon
CC and BCC are supported
The default outlook signature can be used
Messages can be sent immediately, or displayed in the editor to be sent manually
Ultimately this is also a workaround, but there are certainly some situations where this can be useful. It’s probably not right if you’re running an email marketing campaign, or as a replacement for billing automation software; I think it is suited to one-off or infrequent tasks like:
Emailing unique coupon or gift certificate codes
Sending a reminder to vendors while including their specific account numbers
“Personalizing” an email that you would otherwise just CC or BCC to group of recipients.
Speeding up a task where humans are copy/pasting details in to a pre-written message repeatedly
This also makes it easy to be a spammer, please don’t do that. Here is the file:
Also I used some hints from Ron de Bruin to get the signature working (thanks!): https://www.rondebruin.nl/win/s1/outlook/signature.htm. Here is the subroutine that does the work, the functions it requires can be found separately here.
Sub sendEmail()
'by Elliot 8/8/20 www.elliotmade.com
'check the sheet "Instructions" for more info
'tested with office 2010 and 2013
'method for using outlook default signature taken from here: https://www.rondebruin.nl/win/s1/outlook/signature.htm
Dim rSheetName As String, vSheetName As String, iSheetName As String
'-------------------------------------
rSheetName = "Recipients"
vSheetName = "Variables"
iSheetName = "Instructions"
'-------------------------------------
Dim rSht As Worksheet, vSht As Worksheet
Set rSht = Worksheets(rSheetName)
Set vSht = Worksheets(vSheetName)
Dim rLastRow As Long, vLastRow As Long
rLastRow = getLastRow(rSheetName, 1)
vLastRow = getLastRow(vSheetName, 1)
'fixed inputs
Dim subject As String, greeting As String, body As String, signature As String, att1 As String, att2 As String, att3 As String
subject = vSht.Cells(getRowNum("Subject", vSheetName), 2).Value2
greeting = vSht.Cells(getRowNum("Greeting", vSheetName), 2).Value2
body = vSht.Cells(getRowNum("Body", vSheetName), 2).Value2
signature = vSht.Cells(getRowNum("Signature", vSheetName), 2).Value2
att1 = vSht.Cells(getRowNum("Attachment 1", vSheetName), 2).Value2
att2 = vSht.Cells(getRowNum("Attachment 2", vSheetName), 2).Value2
att3 = vSht.Cells(getRowNum("Attachment 3", vSheetName), 2).Value2
Dim mode As String, sigMode As String
mode = vSht.Cells(getRowNum("Send Mode", vSheetName), 2).Value2
sigMode = vSht.Cells(getRowNum("Signature Mode", vSheetName), 2).Value2
Dim fixedVArray As Variant
Dim fixedVCount As Long
If vSht.Cells(getLastRow(vSheetName, 1), 1).Value2 = "Variables" Then GoTo skipFixedVariables 'skip fixed variables if there are none
fixedVArray = vSht.Range(vSht.Cells(getRowNum("Variables", vSheetName, 1) + 1, 1), vSht.Cells(vLastRow, 2)).Value
fixedVCount = UBound(fixedVArray, 1)
'replace the fixed variables into each part of the email
Dim i As Long
For i = 1 To fixedVCount
If InStr(1, subject, "<<") Then
subject = Replace(subject, fixedVArray(i, 1), fixedVArray(i, 2))
End If
If InStr(1, greeting, "<<") Then
greeting = Replace(greeting, fixedVArray(i, 1), fixedVArray(i, 2))
End If
If InStr(1, body, "<<") Then
body = Replace(body, fixedVArray(i, 1), fixedVArray(i, 2))
End If
If InStr(1, signature, "<<") Then
signature = Replace(signature, fixedVArray(i, 1), fixedVArray(i, 2))
End If
Next i
skipFixedVariables:
Dim curSubject As String, curGreeting As String, curBody As String, curSignature As String
'now go through the list of recipients, update each part of the email, then create and send it
Dim listArray As Variant 'columns 1 thru 4 are fixed: TO, CC, BCC, Attachment. Any number of variable columns can follow
Dim listRowCount As Long, listColCount As Long
listRowCount = getLastRow(rSheetName)
listColCount = getLastCol(rSheetName)
If listRowCount < 2 Then 'don't proceed if the list is empty
MsgBox "Nothing found in the recipient list"
Exit Sub
End If
listArray = rSht.Range(rSht.Cells(1, 1), rSht.Cells(listRowCount, listColCount)).Value
Dim j As Long
Dim k As Long
Dim outlookApp As Object
Dim outlookEmail As Object
Set outlookApp = CreateObject("Outlook.Application")
For j = 2 To UBound(listArray, 1)
'reset the temporary message parts
curSubject = subject
curGreeting = greeting
curBody = body
curSignature = signature
If UBound(listArray, 2) > 4 Then 'if there are variable columns, replace each of those into the current message
For k = 5 To UBound(listArray, 2)
If InStr(1, curSubject, "<<") Then
curSubject = Replace(curSubject, listArray(1, k), listArray(j, k))
End If
If InStr(1, curGreeting, "<<") Then
curGreeting = Replace(curGreeting, listArray(1, k), listArray(j, k))
End If
If InStr(1, curBody, "<<") Then
curBody = Replace(curBody, listArray(1, k), listArray(j, k))
End If
If InStr(1, curSignature, "<<") Then
curSignature = Replace(curSignature, listArray(1, k), listArray(j, k))
End If
Next k
End If
'compose the email
Set outlookEmail = outlookApp.CreateItem(0)
With outlookEmail
If sigMode = "Outlook Default" Then 'in order to get the predefined signature from outlook into the message it has to be displayed first
.display
.HTMLbody = curGreeting & "<br>" & curBody & "<br>" & .HTMLbody
Else
.HTMLbody = curGreeting & "<br><br>" & curBody & "<br><br>" & curSignature
End If
.To = listArray(j, 1)
.cc = listArray(j, 2)
.bcc = listArray(j, 3)
.subject = curSubject
'attachments
If att1 <> "" Then .Attachments.Add (att1)
If att2 <> "" Then .Attachments.Add (att2)
If att3 <> "" Then .Attachments.Add (att3)
If listArray(j, 4) <> "" Then .Attachments.Add (listArray(j, 4))
If mode = "Send" Then
.send
Else
.display
End If
End With
Set outlookEmail = Nothing
Next j
Set outlookApp = Nothing
Debug.Print
End Sub
Here are two functions that I will be using in an upcoming sheet, I want to explain them briefly and add them to my small library (file is downloadable at the end of this post).
The names hint at the purpose: given a value to match, they will return the number of the row or column the value was found in, or zero if it wasn’t found at all. The concept is similar to the “vlookup” formula, but performance for these two functions is terrible by comparison and for that reason I don’t recommend using them repetitively in a loop or with large columns of data. I maintain several files with built-in functionality where most of the user input comes from cells in a sheet but I can’t always guarantee the position of those cells – that’s where these two come in handy. Instead of hard-coding the cell address, these functions can find the address by matching the value in that cell which allows you to modify the user-facing sheet without having to update code every time; it also makes the sheet somewhat tolerant of being rearranged by the user, but you need to be careful in case it’s been mangled in such a way that the inputs are found but are totally bogus.
getRowNum()
Function getRowNum(findValue As Variant, Optional sheetName As String, Optional colNum As Long) As Long
'by Elliot 8/9/20 www.elliotmade.com
'this function will return the row number in the first (or specified) column that matches the "findValue" parameter
'this is similar to vlookup, but not as fast or performant
'an example use is to get an input from a sheet where you can't guarantee the position of the cell
'combine this with getColNum() to find a cell value where a known column heading and row label intersect
'****** this requires the "getlastrow" function *******
Dim i As Long
Dim lastRow As Long
Dim j As Long
If sheetName <> "" Then
For j = 1 To Worksheets.Count
If Worksheets(j).Name = sheetName Then GoTo sheetOK
Next j
GoTo abort 'specified sheet name was not found
sheetOK:
End If
'default values for optional parameters
If sheetName = "" Then sheetName = ActiveSheet.Name
If colNum = 0 Then colNum = 1
lastRow = getLastRow(sheetName, colNum)
For i = 1 To lastRow
If Worksheets(sheetName).Cells(i, colNum).Value2 = findValue Then
getRowNum = i
GoTo found
End If
Next i
found:
abort:
End Function
getColNum()
Function getColNum(findValue As Variant, Optional sheetName As String, Optional rowNum As Long) As Long
'by Elliot 8/9/20 www.elliotmade.com
'this function will return the column number in the first (or specified) column that matches the "findValue" parameter
'this is similar to vlookup, but inverted not as fast or performant
'an example use is to get an input from a sheet where you can't guarantee the position of the cell
'combine this with getRowNum() to find a cell value where a known column heading and row label intersect
'****** this requires the "getLastCol" function *******
Dim i As Long
Dim lastCol As Long
Dim j As Long
If sheetName <> "" Then
For j = 1 To Worksheets.Count
If Worksheets(j).Name = sheetName Then GoTo sheetOK
Next j
GoTo abort 'specified sheet name was not found
sheetOK:
End If
'default values for optional parameters
If sheetName = "" Then sheetName = ActiveSheet.Name
If rowNum = 0 Then rowNum = 1
lastCol = getLastCol(sheetName, rowNum)
For i = 1 To lastCol
If Worksheets(sheetName).Cells(rowNum, i).Value2 = findValue Then
getColNum = i
GoTo found
End If
Next i
found:
abort:
End Function
The usage for both of these is simple, just give them a value to match, and if you want to search in a different row/column or a different sheet use the optional parameters. Note that these both rely on two functions I posted previously – getLastRow() and getLastCol(), both of which are included in the file below as well.
Here’s a quick video of this power feed in action. This is a simplified version without a display, it just does direction and speed. Feed rate can be adjusted at any time independent of the spindle RPM.
Here is a circuit diagram for this version:
And here is the code running on the arduino:
//Mini lathe power feed. https://elliotmade.com/2020/08/03/mini-lathe-power-feed-demo/
//need validation for the right/left positions and current position
//////////////////////////////////////////////libraries////////////////////////////////////////////////////////////
#include <SimpleTimer.h>
//https://github.com/jfturcot/SimpleTimer
#include <AccelStepper.h>
//http://www.airspayce.com/mikem/arduino/AccelStepper/
#include <Ewma.h>;
//https://github.com/jonnieZG/EWMA
//////////////////////////////////////////Pins////////////////////////////////////////////////////////////////
const int leftPin = 2;
const int rightPin = 3;
const int speedPin = A0;
const int stepPin = 9;
const int dirPin = 8;
const int enablePin = 10;
////////////////////////////////////////////Configuration//////////////////////////////////////////////////////////////
const int speedMult = 2; //multiplier used for max steps/sec. curSpeed (0-100) * speedMult = steps per second
const int maxAccel = 1000; //steps/sec squared
//operation modes
const byte left = 0;
const byte right = 1;
const byte neutral = 2;
byte curDirection = neutral; //the first time this is checked it will always be different than 3
////////////////////////////////////////////Variables//////////////////////////////////////////////////////////////
int curSpeed = 0;
//Initialize some things
AccelStepper motor(1, stepPin, dirPin);
SimpleTimer timer;
Ewma filteredSpeed(0.1);
void setup() { //Setup
digitalWrite(enablePin,HIGH);
//configure the stepper library
motor.setMaxSpeed(4000);
motor.setAcceleration(maxAccel);
//pin configuration
pinMode(leftPin, INPUT_PULLUP);
pinMode(rightPin, INPUT_PULLUP);
pinMode(enablePin, OUTPUT);
}
void loop() { //Loop
readDirection();
readSpeed();
motor.runSpeed();
}
void readSpeed() { //update the speed knob reading except for auto mode
curSpeed = filteredSpeed.filter(analogRead(speedPin)* speedMult);
if (curDirection == neutral) {
motor.setSpeed(0);
}
else {
if(curDirection == left) {
motor.setSpeed(curSpeed);
}
else {
motor.setSpeed(-curSpeed);
}
}
}
void readDirection() {
if(digitalRead(leftPin) == LOW) {
curDirection = left;
}
else if(digitalRead(rightPin) == LOW) {
curDirection = right;
}
else {
curDirection = neutral;
}
}
If you’d like to build this for yourself, more details can be found on this post. It is powered by a 19v laptop charger, an arduino, and a tb6600 stepper driver.
