|
Subject:
|
Emailing from Excel
|
|
Posted By:
|
danielharris
|
Post Date:
|
1/11/2006 5:39:06 PM
|
Hi, I'm trying to run vb script that emails to specific email accounts whenever an account is "Over Due" in an excel workbook. I like the script from http://p2p.wrox.com/topic.asp?TOPIC_ID=24650 , but I get a Visual Basic error message "System Error &H80004005 ... etc".
Other questions:
Is there anyway of removing the outlook prompts when automating?
Is there anyway of running the script automatically every morning? Does the file need to be open in excel?
I am new at this and would appreciate help in solving this.
My excel file can be downloaded at:
http://www.danielharrisinc.com/excel_email.zip
Thanks
Script from http://p2p.wrox.com/topic.asp?TOPIC_ID=24650 :
Sub sendemail()
Dim OutlookApp As Object
Dim myBodyText As String
Dim myLoop As Integer
Dim myRow As Integer
Dim myRecipient As String
Dim myFirstCellAdd
Dim myCounter As Integer
myCounter = 0
Range("A1").Select
Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Do Until ActiveCell.Address = myFirstCellAdd
myCounter = myCounter + 1
myCurrAdd = ActiveCell.Address
If myCounter = 1 Then myFirstCellAdd = ActiveCell.Address
myRow = ActiveCell.Row
ActiveSheet.Range("A" & myRow).Select
Application.ScreenUpdating = False
For myLoop = 1 To 255
If ActiveCell.Value = "" Then myBodyText = myBodyText & "" & ActiveCell.Value Else myBodyText = myBodyText & " " & ActiveCell.Value
If ActiveCell.Column = 1 Then myRecipient = ActiveCell.Value
If ActiveCell.Column = 256 Then myBodyText = myBodyText Else ActiveCell.Offset(0, 1).Select
Next
ActiveSheet.Range(myCurrAdd).Select
Set OutlookApp = CreateObject("Outlook.Application")
With OutlookApp.CreateItem(olMailItem)
.Subject = "My Subject Line"
.Body = myBodyText
.To = myRecipient
.Send
End With
Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Loop
MsgBox (myCounter)
Application.ScreenUpdating = False
End Sub
|
|
