Hi all,
Basically I am trying to write the errors shown on the message boxes in the files as well. This macro is supposed to attached files to an email: there are two file types let's call them Health and Life. if any of the two files is not found to be attached, then it add the an entry to the message box which I am trying to also save as text files.
everything is working except that:
The first file "HealthErr.txt" stops printing after 470 characters! and the second file "LifeErr.txt" is always empty!!!
Any help is greatly appreciated.
Thanks much,
here is the code:
Basically I am trying to write the errors shown on the message boxes in the files as well. This macro is supposed to attached files to an email: there are two file types let's call them Health and Life. if any of the two files is not found to be attached, then it add the an entry to the message box which I am trying to also save as text files.
everything is working except that:
The first file "HealthErr.txt" stops printing after 470 characters! and the second file "LifeErr.txt" is always empty!!!
Any help is greatly appreciated.
Thanks much,
here is the code:
Code:
Sub Email_Sheet1()
Dim arr(1000) As String
Dim arr2(1000) As String
Dim BlankFound As Boolean
Dim x As Long
Dim y As Long
Dim Mail_Object, Mail_Single As Variant
BlankFound = False
x = 2
y = 0
Z = 0
'
' Write to File
Open "c:\Group Invoices\HealthErr.txt" For Output As #1
Print #1, "No Group Health Invoice for:"
Open "c:\Group Invoices\LifeErr.txt" For Output As #2
Print #2, "No Group Life Invoice for:"
If Sheets("Sheet1").Cells(x, "A").Value = "" Then
BlankFound = True
End If
Do While BlankFound = False
Email_Subject = "Health and Life Insurance Invoice"
nameList = Sheets("Sheet1").Cells(x, "E").Value
Email_Send_To = nameList
Email_Cc = ""
Email_Bcc = ""
Email_Body = "Good Day," & vbCr & vbCr & "Attached is the invoice for " & Sheets("Sheet1").Cells(x, "B").Value & "."
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(o)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.CC = Email_Cc
.BCC = Email_Bcc
.Body = Email_Body
' Attaching Health Invoice
If Sheets("Sheet1").Cells(x, "C").Value = "yes" Or Sheets("Sheet1").Cells(x, "C").Value = "Yes" Then
If FileThere("c:\Group Invoices\Health" & Sheets("Sheet1").Cells(x, "A").Value & ".pdf") Then
.Attachments.Add ("c:\Group Invoices\Health" & Sheets("Sheet1").Cells(x, "A").Value & ".pdf")
Else
arr(y) = Sheets("Sheet1").Cells(x, "A").Value!
' Print Health
Print #1, arr(y)
y = y + 1
End If
End If
' Attaching Life Invoice
If Sheets("Sheet1").Cells(x, "D").Value = "yes" Or Sheets("Sheet1").Cells(x, "D").Value = "Yes" Then
If FileThere("c:\Group Invoices\Life" & Sheets("Sheet1").Cells(x, "A").Value & ".pdf") Then
.Attachments.Add ("c:\Group Invoices\Life" & Sheets("Sheet1").Cells(x, "A").Value & ".pdf")
Else
arr2(Z) = Sheets("Sheet1").Cells(x, "A").Value!
' Print Life
Print #2, arr2(Z)
Z = Z + 1
End If
End If
.Display
' .send
End With
x = x + 1
If Sheets("Sheet1").Cells(x, "A").Value = "" Then
BlankFound = True
End If
Loop
MsgBox "No Health Invoice for:" & vbCrLf & Join(arr, vbCrLf)
MsgBox "No Life Invoice for:" & vbCrLf & Join(arr2, vbCrLf)
Close #1
Close #2
MsgBox "End of list reached!"
End Sub
Last edited by a moderator: