Upgraded to Windows 10, Excel macro to create outlook email and attach file no longer working

melanne42

New Member
Joined
May 15, 2019
Messages
1
I was recently upgraded to Windows 10. When I run my macro in Excel (2016 MSO 64-bit) that is supposed to create an outlook email and attach files from a specific folder, only some of the emails generate now. If both of the Excel files noted in the code don't exist in the folder, Outlook no longer creates the email. This only started happening after my computer was upgraded to Windows 10. Previously, all emails generated regardless if the Excel files existed in the folder.

If I factor out the second Excel file attachment from my code, the emails do generate. I tried factoring out the On Error portion of the code and when it gets to the second file attachment the macro errors out. How do I fix this? Code is below:


Sub InitialRecons()

Dim OApp, OMail As Object
Dim eRng1, eRng2, rng1, rng2, rng3, rng4, cl As Range
Dim sTo, sCC, sLoc, sFile1, sFile2 As String
Dim i As Integer
Dim intNumOfRecons As Integer
intNumOfRecons = ThisWorkbook.Worksheets("MailingList").Range("B6")
sLoc = ThisWorkbook.Worksheets("MailingList").Range("B5") & ""
sFile1 = "CCPS Equipment Reconciliation "
sFile2 = "CCPS Saleables Reconciliation "
Set rng2 = ThisWorkbook.Worksheets("MailingList").Range("B1")
Set rng3 = ThisWorkbook.Worksheets("MailingList").Range("B2")
Set rng4 = ThisWorkbook.Worksheets("MailingList").Range("B4")
For i = 9 To intNumOfRecons
Set rng1 = ThisWorkbook.Worksheets("MailingList").Range("A" & i)
Set eRng1 = ThisWorkbook.Worksheets("MailingList").Range(Cells(i, 2), Cells(i, 11))
Set eRng2 = ThisWorkbook.Worksheets("MailingList").Range(Cells(i, 12), Cells(i, 25))
For Each cl In eRng1
sTo = sTo & ";" & cl.Value
Next
sTo = Mid(sTo, 2)
For Each cl In eRng2
sCC = sCC & ";" & cl.Value
Next
sCC = Mid(sCC, 2)
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)

On Error Resume Next
With OMail
.To = sTo
.CC = sCC
.BCC = ""
.Subject = rng1 & " " & rng2 & " Reconciliation Report"
.Body = "Please find attached a draft copy of the month end reconciliation report for " & rng2 & " " & rng3 & "." & vbNewLine & _
"The purpose of this report is to reconcile any variances that remain open that have not already been reconciled throughout the month." & vbNewLine & vbNewLine & _
"The deadline for submitting reconciling items is prior to " & rng4 & ". Any reconcilable items that require research needs to be submitted within the 10-day reconciliation period. Early submittal of reconcilable items is always encouraged." & vbNewLine & vbNewLine & _
"Any un-reconciled variances at the end of the reconciliation period are subject to chargeback's per the plant contract terms." & vbNewLine & vbNewLine

.Attachments.Add (sLoc & "CCPS Monthly Perpetual Reconciliation.doc")
.Attachments.Add (sLoc & "Plant Variance Trouble Shooting Guide.pdf")
.Attachments.Add (sLoc & sFile1 & rng1 & " " & Left(rng2, 3) & Right(rng3, 2) & ".xls")
.Attachments.Add (sLoc & sFile2 & rng1 & " " & Left(rng2, 3) & Right(rng3, 2) & ".xls")

.Display
End With

On Error GoTo 0
Set OMail = Nothing
Set OApp = Nothing
Set eRng1 = Nothing
Set eRng2 = Nothing
sTo = ""
sCC = ""


Next i

End Sub
 

Forum statistics

Threads
1,082,548
Messages
5,366,227
Members
400,880
Latest member
dwb

Some videos you may like

This Week's Hot Topics

Top