bjurney
Active Member
- Joined
- Aug 24, 2009
- Messages
- 320
I have this code, that will send an e-mail to nearly 150 diffrent people every month. It works okay when it loops the first 100 times or so then it bugs out when it adds the attachment. I get a run-time error
-2147467259 (80004005) and it says that says the error is unspecified. If i try to add the attachment manually in Outlook, it tells me that it can not create the file and to check my permissions for that file. I know that I have permission, and it successfully worked on 100 other e-mails. Is it just an overflow error or is there another way to go about this?
-2147467259 (80004005) and it says that says the error is unspecified. If i try to add the attachment manually in Outlook, it tells me that it can not create the file and to check my permissions for that file. I know that I have permission, and it successfully worked on 100 other e-mails. Is it just an overflow error or is there another way to go about this?
Code:
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Wb As Workbook
Dim FileName As String
Dim subj As String
Dim i As Integer
Set ws = ActiveSheet
iRow = ws.Cells(Rows.Count, 5) _
.End(xlUp).Offset(0, 0).Row
MsgBox ("Sending the e-mails will be faster if you turn off the Spell Check in Outlook off first")
Range("G1").FormulaArray = _
"=SUM(IF(FREQUENCY(IF(RC[-2]:R[15498]C[-2]<>"""",MATCH(""~""&RC[-2]:R[15498]C[-2],RC[-2]:R[15498]C[-2]&"""",0)),ROW(RC[-2]:R[15498]C[-2])-ROW(RC[-2])+1),1))-1"
Range("E1").AutoFilter field:=5, Criteria1:=Cells(iRow, 13).Value
For i = 1 To Range("G1").Value
Cells(iRow, 5).Select
Range("B2:D" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
TextBox1.Paste
subj = "This months report"
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Wb = ActiveWorkbook
With EmailItem
.Subject = subj
.Body = Range("H1").Value & _
TextBox1.Value & _
Range("I1").Value
.SentOnBehalfOfName = "My department"
.To = Cells(iRow, 5).Value & "@mycompany.com"
.CC = ""
.BCC = ""
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add ("I:\Forms\report.pdf")
.display
End With
Application.ScreenUpdating = True
Range("E2:G" & Cells(Rows.Count, 1).End(xlUp).Row).Value = ""
Range("M2:M" & Cells(Rows.Count, 1).End(xlUp).Row).Value = ""
Range("E1").AutoFilter field:=5
iRow = ws.Cells(Rows.Count, 5) _
.End(xlUp).Offset(0, 0).Row
Cells(iRow, 13).Select
Range("E1").AutoFilter field:=5, Criteria1:=Cells(iRow, 13).Value
TextBox1.Value = ""
Next i
MsgBox ("The e-mails are ready to be sent!")
End Sub