Hi please help a first timer.
I am trying to delete mails after extracting the data that I need.
Can't seem to do it without going into a loop.
This is the working code without the deleting bit.
Private Sub notplannedmails()
Dim session As Object
Dim db As Object
Dim dc As Object
Dim doc As Object
Dim str As String
Dim workspace As NOTESUIWORKSPACE
Set session = CreateObject("notes.notessession")
Dim uidoc As NOTESUIDOCUMENT
Set db = session.GETDATABASE("****", "****")
'Searching for the line
Set dc = db.FTSEARCH("""Not Planned consignments on Flight""", 50)
Set doc = dc.GETFIRSTDOCUMENT
counter = 0
While Not (doc Is Nothing)
counter = counter + 1
Dim msg, frm As String
Dim rcvdt As Variant
msg = doc.Body
Sheets("Sheet1").Select
Cells(1, 1).Select
On Error Resume Next
Wait "0.3"
ActiveCell.Value = msg
flt = Cells(1, 1).Value
flt = Mid(flt, 11, 6)
Cells(2, 1).Value = flt
awbs = Cells(1, 1).Value
cntr = 0
startpoint = InStr(awbs, "AWB")
For red = 1 To 10
If startpoint = 0 Then Exit For
cntr = cntr + 1
startpoint = InStr(startpoint + 4, awbs, "AWB")
Next
Sheets("Not Planned Emails").Select
Cells(179, 1).Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
Selection.Value = flt
Selection.Offset(0, 1).Value = cntr
cntr = 0
flt = ""
msg = ""
Sheets("Sheet1").Select
Cells(1, 1).ClearContents
Cells(2, 1).ClearContents
Sheets("Not Planned Emails").Select
Wait "0.3"
Set doc = dc.GETNEXTDOCUMENT(doc)
Wait "0.3"
Call workspace.VIEWREFRESH
Wend
'Call dc.Remove(True) (This bit is not working)
Wait "0.3"
MsgBox counter & " Flights entered."
End Sub
I am trying to delete mails after extracting the data that I need.
Can't seem to do it without going into a loop.
This is the working code without the deleting bit.
Private Sub notplannedmails()
Dim session As Object
Dim db As Object
Dim dc As Object
Dim doc As Object
Dim str As String
Dim workspace As NOTESUIWORKSPACE
Set session = CreateObject("notes.notessession")
Dim uidoc As NOTESUIDOCUMENT
Set db = session.GETDATABASE("****", "****")
'Searching for the line
Set dc = db.FTSEARCH("""Not Planned consignments on Flight""", 50)
Set doc = dc.GETFIRSTDOCUMENT
counter = 0
While Not (doc Is Nothing)
counter = counter + 1
Dim msg, frm As String
Dim rcvdt As Variant
msg = doc.Body
Sheets("Sheet1").Select
Cells(1, 1).Select
On Error Resume Next
Wait "0.3"
ActiveCell.Value = msg
flt = Cells(1, 1).Value
flt = Mid(flt, 11, 6)
Cells(2, 1).Value = flt
awbs = Cells(1, 1).Value
cntr = 0
startpoint = InStr(awbs, "AWB")
For red = 1 To 10
If startpoint = 0 Then Exit For
cntr = cntr + 1
startpoint = InStr(startpoint + 4, awbs, "AWB")
Next
Sheets("Not Planned Emails").Select
Cells(179, 1).Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
Selection.Value = flt
Selection.Offset(0, 1).Value = cntr
cntr = 0
flt = ""
msg = ""
Sheets("Sheet1").Select
Cells(1, 1).ClearContents
Cells(2, 1).ClearContents
Sheets("Not Planned Emails").Select
Wait "0.3"
Set doc = dc.GETNEXTDOCUMENT(doc)
Wait "0.3"
Call workspace.VIEWREFRESH
Wend
'Call dc.Remove(True) (This bit is not working)
Wait "0.3"
MsgBox counter & " Flights entered."
End Sub