buffyslay1
Programmer
why would i get error 429 on
Set OutApp = CreateObject("Outlook.Application")
(all code posted below)
my references are set,
i have done
--------------------------------------------
Step-by-Step Instructions
1. From the Start menu, choose Run, enter "regedit", and press the ENTER key. The Registration Editor appears.
2. In the Registration Editor, browse to HKEY_CLASSES_ROOT\LICENSES.
3. From the Edit menu, select New, then choose Key. A new registry key appears.
4. Enter "F4FC596D-DFFE-11CF-9551-00AA00A3DC45" (without quotes) as the name of the new key.
5. In the right-hand window pane, double-click on the Default entry for the key you created.
6. Enter "mbmabptebkjcdlgtjmskjwtsdhjbmkmwtrak" (without quotes) as the Value Data, and press enter.
7. If you need to update multiple PCs, create a REG file for that key by choosing 'Export Registry File' from the Registry menu. Then, copy the REG file to other PCs and double-click on it to add the key to the registry.
8. Choose Exit from the Registry menu to close the Registration Editor.
-------------------------------------------
Sub sendEmails()
'Dim OutApp As Outlook.Application
'Dim OutMail As Outlook.MailItem
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
On Error GoTo cleanup
For Each cell In Sheets("Send Emails").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
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
cleanup:
'MsgBox Err.Description
MsgBox Err.Number & " " & Err.Description
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Set OutApp = CreateObject("Outlook.Application")
(all code posted below)
my references are set,
i have done
--------------------------------------------
Step-by-Step Instructions
1. From the Start menu, choose Run, enter "regedit", and press the ENTER key. The Registration Editor appears.
2. In the Registration Editor, browse to HKEY_CLASSES_ROOT\LICENSES.
3. From the Edit menu, select New, then choose Key. A new registry key appears.
4. Enter "F4FC596D-DFFE-11CF-9551-00AA00A3DC45" (without quotes) as the name of the new key.
5. In the right-hand window pane, double-click on the Default entry for the key you created.
6. Enter "mbmabptebkjcdlgtjmskjwtsdhjbmkmwtrak" (without quotes) as the Value Data, and press enter.
7. If you need to update multiple PCs, create a REG file for that key by choosing 'Export Registry File' from the Registry menu. Then, copy the REG file to other PCs and double-click on it to add the key to the registry.
8. Choose Exit from the Registry menu to close the Registration Editor.
-------------------------------------------
Sub sendEmails()
'Dim OutApp As Outlook.Application
'Dim OutMail As Outlook.MailItem
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
On Error GoTo cleanup
For Each cell In Sheets("Send Emails").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
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
cleanup:
'MsgBox Err.Description
MsgBox Err.Number & " " & Err.Description
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub