Send Emails

Ok -

I have the following code (posted at bottom) that errors out at

**Set OutApp = CreateObject("Outlook.Application")**

the error message is

Run-time error 429
ActvieX component cannot create object


I have the reference set
(You must add a reference to the Microsoft outlook Library.

1) Go to the VBA editor, Alt -F11
2) ToolsReferences in the Menu bar
3) Place a Checkmark before Microsoft Outlook 9 Object Library
)


It works on other machines (PCs with the same build as mine) so where
am i going wrong?


Sub sendEmails()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range

Application.ScreenUpdating = False


Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Sheets("Send
Emails").Columns("B").Cells.SpecialCells(xlCellTyp eConstants)
If cell.Offset(0, 1).Value < "" Then
If cell.Offset(0, 1).Value < "" Then

Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Budget for " & cell.Offset(0, 2).Value
.Body = "Dear " & cell.Offset(0, -1).Value & vbCrLf &
vbCrLf
.Body = .Body & "Please find attached latest update
showing the actuals against budget for " & cell.Offset(0, 2).Value &
vbCrLf & vbCrLf

If cell.Offset(0, 3) < "" Then
.Body = .Body & cell.Offset(0, 3).Value & vbCrLf &
vbCrLf
End If
If cell.Offset(0, 4) < "" Then
.Body = .Body & cell.Offset(0, 4).Value & vbCrLf &
vbCrLf
End If
.Body = .Body & "If you have any queries
- please let me know. " & vbCrLf & vbCrLf
.Body = .Body & "Many thanks " & vbCrLf & vbCrLf
.Body = .Body & "Systems Finance Team" & vbCrLf &
vbCrLf
.Attachments.Add cell.Offset(0, 1).Value
.Display 'Or use Display
If cell.Offset(0, 5) = "Y" Then
.ReadReceiptRequested = True
Else
.ReadReceiptRequested = False
End If
End With
Set OutMail = Nothing
End If
End If
Next cell
Exit Sub

i tried

Private Sub Form_Click()
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\testfile.txt", True)
a.WriteLine ("This is a test.")
a.Close
End Sub

which worked...?

Hi Buffyslay

Start with this KB
http://support.microsoft.com/default...b;en-us;828550

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Buffyslay" wrote in message oups.com...
Send Emails

Ok -

I have the following code (posted at bottom) that errors out at

**Set OutApp = CreateObject("Outlook.Application")**

the error message is

Run-time error 429
ActvieX component cannot create object


I have the reference set
(You must add a reference to the Microsoft outlook Library.

1) Go to the VBA editor, Alt -F11
2) ToolsReferences in the Menu bar
3) Place a Checkmark before Microsoft Outlook 9 Object Library
)


It works on other machines (PCs with the same build as mine) so where
am i going wrong?


Sub sendEmails()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range

Application.ScreenUpdating = False


Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Sheets("Send
Emails").Columns("B").Cells.SpecialCells(xlCellTyp eConstants)
If cell.Offset(0, 1).Value < "" Then
If cell.Offset(0, 1).Value < "" Then

Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Budget for " & cell.Offset(0, 2).Value
.Body = "Dear " & cell.Offset(0, -1).Value & vbCrLf &
vbCrLf
.Body = .Body & "Please find attached latest update
showing the actuals against budget for " & cell.Offset(0, 2).Value &
vbCrLf & vbCrLf

If cell.Offset(0, 3) < "" Then
.Body = .Body & cell.Offset(0, 3).Value & vbCrLf &
vbCrLf
End If
If cell.Offset(0, 4) < "" Then
.Body = .Body & cell.Offset(0, 4).Value & vbCrLf &
vbCrLf
End If
.Body = .Body & "If you have any queries
- please let me know. " & vbCrLf & vbCrLf
.Body = .Body & "Many thanks " & vbCrLf & vbCrLf
.Body = .Body & "Systems Finance Team" & vbCrLf &
vbCrLf
.Attachments.Add cell.Offset(0, 1).Value
.Display 'Or use Display
If cell.Offset(0, 5) = "Y" Then
.ReadReceiptRequested = True
Else
.ReadReceiptRequested = False
End If
End With
Set OutMail = Nothing
End If
End If
Next cell
Exit Sub