theboyscout
New Member
- Joined
- Nov 29, 2012
- Messages
- 26
Hello,
I'm trying to create a script that would search a folder, find the last inserted spreadsheet, locate a field and if that field is > 0 send an email. And this is to be run weekly.
[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"]F[/TD]
[TD="align: center"]L[/TD]
[TD="align: center"]O[/TD]
[/TR]
[TR]
[TD="align: center"]Descr[/TD]
[TD="align: center"]Email[/TD]
[TD="align: center"]Available_Spots[/TD]
[/TR]
[TR]
[TD="align: center"]60749[/TD]
[TD="align: center"]jon.snow@got.com[/TD]
[TD="align: center"]1[/TD]
[/TR]
</tbody>[/TABLE]
I've scraped up a number of scripts from other users (unfortunately, I can't remember profile names to give them credit), see
Sub Waitlist_Email()
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
Dim OutApp As Object
Dim OutMail As Object
Dim strbody, SigString, Signature As String
Dim MailAttachments As String
Dim cell As Variant
Dim GetBoiler As Object
'Search for recent file in folder
MyPath = “C:\Users\Desktop\Waitlist"
If Right(MyPath, 1) <> “ \ ” Then MyPath = MyPath & “ \ ”
MyFile = Dir(MyPath & “ * .xls”, vbNormal)
If Len(MyFile) = 0 Then
MsgBox “No files were found…”, vbExclamation
Exit Sub
End If
Do While Len(MyFile) > 0
LMD = FileDateTime(MyPath & MyFile)
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
MyFile = Dir
Loop
Workbooks.Open MyPath & LatestFile
'If file is located send email
Sheets("Sheet1").Select
Range("A1").Select
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
'On Error GoTo cleanup
For Each cell In Columns("L").Cells
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "O").Value) > "0" Then
With Application.ActiveSheet
MailAttachments = Cells(cell.Row, "E").Value
End With
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Enrollment available " & Cells(cell.Row, "F").Value 'Refer value from column F (Course Description)
.HTMLBody = "" & _
"Hello ," & Cells(cell.Row, "H") & ", " & ""
" & _
"Blah blah blah " & Cells(cell.Row, "F") & " blah blah blah " & Cells(cell.Row, "K") & " blah blah blah. " & ""
" & _
"
" & _
"
" & _
"
" & _
"**************************************************************************************************************" & "
" & _
"This is your signature file. It will always be 7 rows below whatever text you add in the macro code."
'To add another line in your message or signature without skipping a row, end the line of text with
'a quotation symbol and then an ampersand and an underscore. Ex: end of text." & _
'.Attachments.Add MailAttachments
.Display
'Or use .Send
End With
On Error GoTo 0
End If
Next
cleanup:
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
I'm getting error message at
Any help would be appreciated
I'm trying to create a script that would search a folder, find the last inserted spreadsheet, locate a field and if that field is > 0 send an email. And this is to be run weekly.
[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"]F[/TD]
[TD="align: center"]L[/TD]
[TD="align: center"]O[/TD]
[/TR]
[TR]
[TD="align: center"]Descr[/TD]
[TD="align: center"]Email[/TD]
[TD="align: center"]Available_Spots[/TD]
[/TR]
[TR]
[TD="align: center"]60749[/TD]
[TD="align: center"]jon.snow@got.com[/TD]
[TD="align: center"]1[/TD]
[/TR]
</tbody>[/TABLE]
I've scraped up a number of scripts from other users (unfortunately, I can't remember profile names to give them credit), see
below
:Sub Waitlist_Email()
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
Dim OutApp As Object
Dim OutMail As Object
Dim strbody, SigString, Signature As String
Dim MailAttachments As String
Dim cell As Variant
Dim GetBoiler As Object
'Search for recent file in folder
MyPath = “C:\Users\Desktop\Waitlist"
If Right(MyPath, 1) <> “ \ ” Then MyPath = MyPath & “ \ ”
MyFile = Dir(MyPath & “ * .xls”, vbNormal)
If Len(MyFile) = 0 Then
MsgBox “No files were found…”, vbExclamation
Exit Sub
End If
Do While Len(MyFile) > 0
LMD = FileDateTime(MyPath & MyFile)
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
MyFile = Dir
Loop
Workbooks.Open MyPath & LatestFile
'If file is located send email
Sheets("Sheet1").Select
Range("A1").Select
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
'On Error GoTo cleanup
For Each cell In Columns("L").Cells
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "O").Value) > "0" Then
With Application.ActiveSheet
MailAttachments = Cells(cell.Row, "E").Value
End With
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Enrollment available " & Cells(cell.Row, "F").Value 'Refer value from column F (Course Description)
.HTMLBody = "" & _
"Hello ," & Cells(cell.Row, "H") & ", " & ""
" & _
"Blah blah blah " & Cells(cell.Row, "F") & " blah blah blah " & Cells(cell.Row, "K") & " blah blah blah. " & ""
" & _
"
" & _
"
" & _
"
" & _
"**************************************************************************************************************" & "
" & _
"This is your signature file. It will always be 7 rows below whatever text you add in the macro code."
'To add another line in your message or signature without skipping a row, end the line of text with
'a quotation symbol and then an ampersand and an underscore. Ex: end of text." & _
'.Attachments.Add MailAttachments
.Display
'Or use .Send
End With
On Error GoTo 0
End If
Next
cleanup:
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
I'm getting error message at
" & _
<strike></strike> and I can't figure out how to schedule to run weekly.Any help would be appreciated
