Outlook 2013>Move Method>Criteria>Variables

[aworthey]

Hello,

I'm trying to organize incoming emails based on values of string variables I'm already utilizing elsewhere. I know that my variables and Move statement is working properly. The error occurs with how I'm testing my criteria. I must not be choosing the correct method.

Essentially, I want to test one variable to see if the string is not empty against another variable whose string should be empty. My logic, I believe, is accurate...just not the method.

Here's the snippet of code:

If ga <> "" & te = "" Then
'olItem.UnRead = False
olItem.Move gaFolder


ElseIf sg <> "" & te = "" Then
olItem.Move gaFolder


ElseIf ot <> "" & te = "" Then
'olItem.UnRead = False
olItem.Move gaFolder


Else
olItem.Move teFolder
End If

Thanks for any suggestions!

[aworthey]

This code is moving the email now. But it is moving multiple copies of the same email to both sub inboxes. My string variable "ga" is the only variable that should have a value.

If ((Len(ga) <> 0) And (Len(te) = 0)) Then
'olItem.UnRead = False
olItem.Move gaFolder


ElseIf ((Len(sg) <> 0) And (Len(te) = 0)) Then
'olItem.UnRead = False
olItem.Move gaFolder


ElseIf ((Len(ot) <> 0) And (Len(te) = 0)) Then
'olItem.UnRead = False
olItem.Move gaFolder


ElseIf ((Len(re) <> 0) And (Len(te) = 0)) Then
'olItem.UnRead = False
olItem.Move gaFolder


Else
olItem.Move teFolder
End If

[aworthey]

Here's what I got to actually work:

Option Explicit


Sub CopyToExcel(olItem As MailItem)


Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim gaFolder As Folder
Dim teFolder As Folder
Dim vText As Variant
Dim sText As String
Dim sAddr As String
Dim vAddr As Variant
Dim vItem As Variant
Dim i As Long, j As Long
Dim rCount As Long
Dim bXStarted As Boolean
Dim ga As String, te As String, sg As String, ot As String, re As String
Dim ga2 As String, te2 As String, sg2 As String, ot2 As String, re2 As String
Const strWorkSheetName As String = "Sheet2"
Const strWorkBookName As String = "C:\Users\ko98240\Desktop\Book1.xlsm" 'the path of the workbook


Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Set teFolder = olFolder.Folders("Tank & Enclosure")
Set gaFolder = olFolder.Folders("Generator and ATS")


'Open the workbook to input the data
Set xlWB = Excel.Workbooks.Open("C:\Users\ko98240\Desktop\Book1.xlsm")
Set xlSheet = xlWB.Sheets("Sheet2")


'Process the message
With olItem
sText = olItem.Body
vText = Split(sText, Chr(13))
'Find the next empty line of the worksheet
rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row + 1


'Check each line of text in the message body
For i = UBound(vText) To 0 Step -1
If InStr(1, vText(i), "Job Name:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("A" & rCount) = Trim(vItem(1))
End If


If InStr(1, vText(i), "Contact Name:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("B" & rCount) = Trim(vItem(1))
End If


If InStr(1, vText(i), "Company:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("C" & rCount) = Trim(vItem(1))
End If


If InStr(1, vText(i), "Generator and ATS:") > 0 Then
vItem = Split(vText(i), Chr(58))
ga = "Generator and ATS:  " & Trim(vItem(1))
ga2 = Trim(vItem(1))
End If


If InStr(1, vText(i), "Tank & Enclosure:") > 0 Then
vItem = Split(vText(i), Chr(58))
te = "Tank & Enclosure:  " & Trim(vItem(1))
te2 = Trim(vItem(1))
End If


If InStr(1, vText(i), "Switchgear:") > 0 Then
vItem = Split(vText(i), Chr(58))
sg = "Switchgear:  " & Trim(vItem(1))
sg2 = Trim(vItem(1))
End If


If InStr(1, vText(i), "Other:") > 0 Then
vItem = Split(vText(i), Chr(58))
ot = "Other:  " & Trim(vItem(1))
ot2 = Trim(vItem(1))
End If


If InStr(1, vText(i), "Revisions:") > 0 Then
vItem = Split(vText(i), Chr(58))
re = "Revisions:  " & Trim(vItem(1))
re2 = Trim(vItem(1))
End If


Next i


'Move the incoming email to appropriate sub inbox
If ((Len(ga2) > 0) And (Len(te2) = 0)) Then
olItem.Move gaFolder


ElseIf ((Len(sg2) > 0) And (Len(te2) = 0)) Then
olItem.Move gaFolder


ElseIf ((Len(ot2) > 0) And (Len(te2) = 0)) Then
olItem.Move gaFolder


ElseIf ((Len(re2) > 0) And (Len(te2) = 0)) Then
olItem.Move gaFolder


Else
olItem.Move teFolder
End If


'Copy notes to one note field
xlSheet.Range("D" & rCount) = ga & "  " & te & "  " & sg & "  " & ot & "  " & re


'Separate date and time from time stamp
xlSheet.Range("E" & rCount) = Format(olItem.ReceivedTime, "mm/dd/yyyy")
xlSheet.Range("F" & rCount) = Format(olItem.ReceivedTime, "hh:mm:ss AM/PM")


xlWB.Save
End With
xlWB.Close SaveChanges:=True
If bXStarted Then
xlApp.Quit
End If
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
End Sub

[aworthey]

I had to move "Next i" to before the Move method statements.