kitegaroo
05-04-2016, 04:08 AM
Hello,
I´m crispy new to this Forum and like few others approaching with something I cant solve by myself so far.
That´s why I´m using this opportunity to post my code and ask for some help.
What is my script about ?
Well, I want my macro to search all the mailitems in my inbox Folder by looking for a particular syntax.
After that I´d like to iterate over all searched items and get informations from this particular mailitem and write it into an Excel file and move my item afterwards into a specific Folder.
That all works so far but the problem is , as soon as I run the script without using a breakpoint it stops with the failure notice
Runtime error 91: Object variable or with block variable not set".
Struggling to find the right area where this issue is located.
Sub MoveItemsToFolders()
Dim oSearch As Search
Dim oTable As Table
Dim strQuery As String
Dim ziel As String
ziel = Environ("USERPROFILE") & ("\Documents\Wahlen\")
Dim anlagen As Attachments
'Set blnSearchComp = False
Dim queries(12) As String
Dim fers(12) As String
Dim rCount As Integer
'~~> Excel Variables
Dim oXLApp As Object
Dim oXLwb As Object
Dim oXLws As Object
'Construct filter. 0x0037001E represents Subject
strQueryFSVMe = _
"blabla& _
" ci_phrasematch 'FSV-Me'"
queries(1) = strQueryFSVMe
fers(1) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00120000"
strQueryFSVW = _
"blabla" & _
" ci_phrasematch 'FSV-W'"
queries(2) = strQueryFSVW
fers(2) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00100000"
strQueryFSVIuE = _
"bla"& _
" ci_phrasematch 'FSV-IuE'"
queries(3) = strQueryFSVIuE
fers(3) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00110000"
strQueryFSVAg = _
"foo" & _
" ci_phrasematch 'FSV-Ag'"
queries(4) = strQueryFSVAg
fers(4) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C000F0000"
strQueryFSVMw = _
"foo" & _
" ci_phrasematch 'FSV-MW'"
queries(5) = strQueryFSVMw
fers(5) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00130000"
strQueryFSVSAuG = _
"foo" & _
" ci_phrasematch 'FSV-SAuG'"
queries(6) = strQueryFSVSAuG
fers(6) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00140000"
strQuerySPMe = _
"foo" & _
" ci_phrasematch 'SP-Me'"
queries(7) = strQuerySPMe
fers(7) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00180000"
strQuerySPIuE = _
"foo" & _
" ci_phrasematch 'SP-IuE'"
queries(8) = strQuerySPIuE
fers(8) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00170000"
strQuerySPW = _
"foo" & _
" ci_phrasematch 'SP-W'"
queries(9) = strQuerySPW
fers(9) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00160000"
strQuerySPAg = _
"foo" & _
" ci_phrasematch 'SP-Ag'"
queries(10) = strQuerySPAg
fers(10) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00150000"
strQuerySPMW = _
"foo" & _
" ci_phrasematch 'SP-MW'"
queries(11) = strQuerySPMW
fers(11) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00190000"
strQuerySAuG = _
"foo" & _
" ci_phrasematch 'SP-SAuG'"
queries(12) = strQuerySAuG
fers(12) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C001A0000"
Dim MyDestFolder As Folder
Dim Valines() As String
Dim Datei As String
Dim l As Integer
Dim MyItem As Outlook.MailItem
Dim MyNameSpace As Outlook.NameSpace
Dim MyInbox As Outlook.Folder
Dim MyResults As Results
Dim CountRows As Integer
Set MyNameSpace = Application.GetNamespace("MAPI")
Set MyInbox = MyNameSpace.GetDefaultFolder(olFolderInbox)
l = 22
For m = 1 To (UBound(queries) - LBound(queries))
Set MyDestFolder = MyNameSpace.GetFolderFromID(fers(m))
Set oSearch = _
Application.AdvancedSearch(MyInbox, queries(m), False, queries(m))
Set MyResults = oSearch.Results
CountRows = MyResults.Count
For i = CountRows To 1 Step -1
Set MyItem = MyResults.Item(1)
Valines() = Split(MyItem.Body, "")
'~~> Establish an EXCEL application object
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
'~~> If not found then create new instance
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
Select Case m
Case 1
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "FSV-Me" + ".xlsx")
Case 2
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "FSV-W" + ".xlsx")
Case 3
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "FSV-IuE" + ".xlsx")
Case 4
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "FSV-Ag" + ".xlsx")
Case 5
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "FSV-MW" + ".xlsx")
Case 6
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "FSV-SAuG" + ".xlsx")
Case 7
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "SP-Me" + ".xlsx")
Case 8
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "SP-IuE" + ".xlsx")
Case 9
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "SP-W" + ".xlsx")
Case 10
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "SP-Ag" + ".xlsx")
Case 11
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "SP-MW" + ".xlsx")
Case 12
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "SP-SAuG" + ".xlsx")
End Select
Set oXLws = oXLwb.Sheets(1)
oXLws.Activate
Set Rn = oXLws.Range("a1")
Rn.Activate
'~~> Show Excel
oXLApp.Visible = True
'Find the next empty line of the worksheet
rCount = oXLws.Range("B" & oXLws.Rows.Count).End(-4162).Row + 1
Set anlagen = MyItem.Attachments
For k = 1 To anlagen.Count
Datei = ziel & Valines(10) + "\" + Valines(13) + "\" + Format(MyItem.ReceivedTime, "dd_mm_yyyy") & "_" & Int(1000000 * Rnd) + 1 & "_" & anlagen.Item(k).FileName
anlagen.Item(k).SaveAsFile Datei
Next k
oXLws.Range("B" & rCount) = Valines(4)
oXLws.Range("C" & rCount) = Valines(7)
oXLws.Range("D" & rCount) = Valines(10)
oXLws.Range("E" & rCount) = Valines(13)
oXLws.Range("F" & rCount) = Valines(16)
Do
oXLws.Range("G" & rCount) = oXLws.Range("G" & rCount) + Valines(l)
l = l + 1
Loop Until Valines(l) = ""
l = 22
oXLws.Range("H" & rCount) = Datei
rCount = rCount + 1
oXLwb.Save
MyItem.Move MyDestFolder
CountRows = MyResults.Count
Next
Next m
oXLwb.Close
End Sub
Hope to get any Feedback from you .
Thanks a lot
I´m crispy new to this Forum and like few others approaching with something I cant solve by myself so far.
That´s why I´m using this opportunity to post my code and ask for some help.
What is my script about ?
Well, I want my macro to search all the mailitems in my inbox Folder by looking for a particular syntax.
After that I´d like to iterate over all searched items and get informations from this particular mailitem and write it into an Excel file and move my item afterwards into a specific Folder.
That all works so far but the problem is , as soon as I run the script without using a breakpoint it stops with the failure notice
Runtime error 91: Object variable or with block variable not set".
Struggling to find the right area where this issue is located.
Sub MoveItemsToFolders()
Dim oSearch As Search
Dim oTable As Table
Dim strQuery As String
Dim ziel As String
ziel = Environ("USERPROFILE") & ("\Documents\Wahlen\")
Dim anlagen As Attachments
'Set blnSearchComp = False
Dim queries(12) As String
Dim fers(12) As String
Dim rCount As Integer
'~~> Excel Variables
Dim oXLApp As Object
Dim oXLwb As Object
Dim oXLws As Object
'Construct filter. 0x0037001E represents Subject
strQueryFSVMe = _
"blabla& _
" ci_phrasematch 'FSV-Me'"
queries(1) = strQueryFSVMe
fers(1) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00120000"
strQueryFSVW = _
"blabla" & _
" ci_phrasematch 'FSV-W'"
queries(2) = strQueryFSVW
fers(2) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00100000"
strQueryFSVIuE = _
"bla"& _
" ci_phrasematch 'FSV-IuE'"
queries(3) = strQueryFSVIuE
fers(3) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00110000"
strQueryFSVAg = _
"foo" & _
" ci_phrasematch 'FSV-Ag'"
queries(4) = strQueryFSVAg
fers(4) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C000F0000"
strQueryFSVMw = _
"foo" & _
" ci_phrasematch 'FSV-MW'"
queries(5) = strQueryFSVMw
fers(5) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00130000"
strQueryFSVSAuG = _
"foo" & _
" ci_phrasematch 'FSV-SAuG'"
queries(6) = strQueryFSVSAuG
fers(6) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00140000"
strQuerySPMe = _
"foo" & _
" ci_phrasematch 'SP-Me'"
queries(7) = strQuerySPMe
fers(7) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00180000"
strQuerySPIuE = _
"foo" & _
" ci_phrasematch 'SP-IuE'"
queries(8) = strQuerySPIuE
fers(8) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00170000"
strQuerySPW = _
"foo" & _
" ci_phrasematch 'SP-W'"
queries(9) = strQuerySPW
fers(9) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00160000"
strQuerySPAg = _
"foo" & _
" ci_phrasematch 'SP-Ag'"
queries(10) = strQuerySPAg
fers(10) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00150000"
strQuerySPMW = _
"foo" & _
" ci_phrasematch 'SP-MW'"
queries(11) = strQuerySPMW
fers(11) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C00190000"
strQuerySAuG = _
"foo" & _
" ci_phrasematch 'SP-SAuG'"
queries(12) = strQuerySAuG
fers(12) = "00000000137F761C5700DE4799D26C8DE78E756B01002B7059088F85FE4D803955637ACC479 E0012515C001A0000"
Dim MyDestFolder As Folder
Dim Valines() As String
Dim Datei As String
Dim l As Integer
Dim MyItem As Outlook.MailItem
Dim MyNameSpace As Outlook.NameSpace
Dim MyInbox As Outlook.Folder
Dim MyResults As Results
Dim CountRows As Integer
Set MyNameSpace = Application.GetNamespace("MAPI")
Set MyInbox = MyNameSpace.GetDefaultFolder(olFolderInbox)
l = 22
For m = 1 To (UBound(queries) - LBound(queries))
Set MyDestFolder = MyNameSpace.GetFolderFromID(fers(m))
Set oSearch = _
Application.AdvancedSearch(MyInbox, queries(m), False, queries(m))
Set MyResults = oSearch.Results
CountRows = MyResults.Count
For i = CountRows To 1 Step -1
Set MyItem = MyResults.Item(1)
Valines() = Split(MyItem.Body, "")
'~~> Establish an EXCEL application object
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
'~~> If not found then create new instance
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
Select Case m
Case 1
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "FSV-Me" + ".xlsx")
Case 2
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "FSV-W" + ".xlsx")
Case 3
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "FSV-IuE" + ".xlsx")
Case 4
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "FSV-Ag" + ".xlsx")
Case 5
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "FSV-MW" + ".xlsx")
Case 6
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "FSV-SAuG" + ".xlsx")
Case 7
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "SP-Me" + ".xlsx")
Case 8
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "SP-IuE" + ".xlsx")
Case 9
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "SP-W" + ".xlsx")
Case 10
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "SP-Ag" + ".xlsx")
Case 11
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "SP-MW" + ".xlsx")
Case 12
Set oXLwb = oXLApp.Workbooks.Open(ziel + Valines(10) + "\" + Valines(13) + "\" + "bewerber" + "SP-SAuG" + ".xlsx")
End Select
Set oXLws = oXLwb.Sheets(1)
oXLws.Activate
Set Rn = oXLws.Range("a1")
Rn.Activate
'~~> Show Excel
oXLApp.Visible = True
'Find the next empty line of the worksheet
rCount = oXLws.Range("B" & oXLws.Rows.Count).End(-4162).Row + 1
Set anlagen = MyItem.Attachments
For k = 1 To anlagen.Count
Datei = ziel & Valines(10) + "\" + Valines(13) + "\" + Format(MyItem.ReceivedTime, "dd_mm_yyyy") & "_" & Int(1000000 * Rnd) + 1 & "_" & anlagen.Item(k).FileName
anlagen.Item(k).SaveAsFile Datei
Next k
oXLws.Range("B" & rCount) = Valines(4)
oXLws.Range("C" & rCount) = Valines(7)
oXLws.Range("D" & rCount) = Valines(10)
oXLws.Range("E" & rCount) = Valines(13)
oXLws.Range("F" & rCount) = Valines(16)
Do
oXLws.Range("G" & rCount) = oXLws.Range("G" & rCount) + Valines(l)
l = l + 1
Loop Until Valines(l) = ""
l = 22
oXLws.Range("H" & rCount) = Datei
rCount = rCount + 1
oXLwb.Save
MyItem.Move MyDestFolder
CountRows = MyResults.Count
Next
Next m
oXLwb.Close
End Sub
Hope to get any Feedback from you .
Thanks a lot