azizrasul
Well-known Member
- Joined
- Jul 7, 2003
- Messages
- 1,304
- Office Version
- 365
- 2019
- 2016
- Platform
- Windows
I get an 'The operation failed' error message in the line in red below. At one point i restarted my PC and it all worked, but now it has come back again. Has anyone ever come across this issue?
Rich (BB code):
For Each cell In Range("A3:A" & intLastFilteredRow).SpecialCells(xlCellTypeVisible).Cells
Workbooks(strFilename).Activate
blnSendEmail = False
strSurveyID = cell.Value
strLandParcelID = cell.Offset(0, 1).Value
dteSurveyDate = cell.Offset(0, 2).Value
strAssetRef = cell.Offset(0, 3).Value
strSurveyorName = cell.Offset(0, 8).Value
dteCancellationDate = cell.Offset(0, 13).Value
dteRequestLastSentDate = cell.Offset(0, 17).Value
cell.Offset(0, 17).Select 'Needed below in order to insert date.
ThisWorkbook.Activate
If Trim(strSurveyorName) <> "" Then
With Sheets("Surveyor Info").Range("A:A")
Set rng = .Find(What:=strSurveyorName, After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not rng Is Nothing Then
Application.Goto rng, True
strEmailAddress = rng.Offset(0, 6)
Else
strEmailAddress = ""
End If
End With
End If
If dteRequestLastSentDate = "00:00:00" Then
blnSendEmail = True
ElseIf CInt(Date - dteRequestLastSentDate) > 7 Then
blnSendEmail = True
End If
If blnSendEmail = True Then
If strEmailAddress <> "" Then
Set oApp = New Outlook.Application
Set olSession = oApp.GetNamespace("MAPI")
Set olMail = oApp.CreateItem(olMailItem)
With olMail
Set myInspector = .GetInspector
Set myRecipient = .Recipients.Add(strEmailAddress)
.SentOnBehalfOfName = "EWCNorth_HealthSafety@aecom.com"
.Subject = "Proforma Request for Land Parcel ID:" & strLandParcelID
If dteRequestLastSentDate <> "00:00:00" Then
If CInt(Date - dteRequestLastSentDate) > 7 Then
.Body = "Hello, ... "
End If
Else
.Body = "Hello, ..."
End If
' .Display
' .Send
End With
Set myRecipient = Nothing
Set myInspector = Nothing
Set olMail = Nothing
Set olSession = Nothing
Set oApp = Nothing
Workbooks(strFilename).Activate
ActiveCell.Value = Now
x = x + 1
Else
j = j + 1
End If
End If
Next cell