I want to add a custom property to my calendar items (ideally it will contain a unique ID), so that I can use Restrict to collect instances of recurring appointment items. But while I seem to be able to add the property, I cannot find any way to use the Items.Restrict() method to find items containing the property.
I know that I can get a collection of all the items on the calendar and loop every one to find what I want - but that is the current method that I use and it is way to slow.
I looked at dozens of sites and found conflicting answers about whether this is even possible - but Microsoft seems to think it is (see first link), as well as other people (see second link).
I have used the locals window in debug mode and Restrict is definitely not collecting any objects.
I can only assume that I am doing something wrong in the Column section (based on this "The custom properties must be defined in the folder where you are applying the filter. If the custom properties are only defined in the item, the search will fail" - first link) or the view but I cannot figure out what.
I do know that I cannot use a TableView because it will not include recurrence instances (see third link).
https://learn.microsoft.com/en-us/office/vba/outlook/how-to/search-and-filter/filtering-a-custom-field
http://www.outlookcode.com/threads.aspx?forumid=2&messageid=27942
https://learn.microsoft.com/en-us/office/client-developer/outlook/pia/how-to-filter-recurring-appointments-and-search-for-a-string-in-the-subject
Sub AddAndRestrictCustomProperty()
Dim NS As Outlook.NameSpace
Dim dcal As Folder
Dim dCalItmes As Items
Dim objd As Items, objc As Items
Dim item As Outlook.AppointmentItem
Dim upCheck As Outlook.UserProperty
Dim udpCheck As Outlook.UserDefinedProperty
Set NS = Application.GetNamespace("MAPI")
Set dcal = NS.GetDefaultFolder(olFolderCalendar)
Set dCalItems = dcal.Items
Set item = dCalItems.Add(olAppointmentItem)
With item
.Subject = "Placeholder Appt"
.Start = "2/12/2019 4:30PM"
.Body = "nothing"
.MeetingStatus = olMeeting
.Save
End With
'adds custom property
Set upCheck = item.UserProperties.Add("userPropCheck", olText, True, olText)
upCheck.Value = "testing"
Debug.Print item.ItemProperties.item("userPropCheck").Value 'prints "testing"
item.Save
'gets instances of custom property in objd
dCalItems.Sort "[Start]"
dCalItems.IncludeRecurrences = True
Set objd = dCalItems.Restrict("[subject] = Placeholder Appt And [Start] >= '2/11/2019' and [Start] <= '2/13/2019'")
Debug.Print objd(1).ItemProperties.item("userPropCheck").Value 'prints testing
'setColumns seems to not work for custom properties
objd.SetColumns ("userPropCheck, subject, start") 'ERROR: The property "userPropCheck" is unknown error
'Jet Restrict Fails
Set objc = dCalItems.Restrict("[userPropCheck] = " & Chr(34) & "testing" & Chr(34))
Debug.Print objc(1).ItemProperties.item("userPropCheck").Value 'ERROR: object variable or with block variable not set error
'Jet Find Fails
Set objc = dCalItems.Find("[userPropCheck] = " & Chr(34) & "testing" & Chr(34))
Debug.Print objc(1).ItemProperties.item("userPropCheck").Value 'ERROR: object variable or with block variable not set error
'DSAL Restrict Fails
sFilter = "#SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/userPropCheck" & Chr(34) & "= 'testing'" ''"#SQL=" & Chr$(34) & "http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/userPropCheck" & Chr(34) & " = 'testing'"
Set objc = dCalItems.Restrict(sFilter)
Debug.Print objc(1).ItemProperties.item("userPropCheck").Value 'ERROR: object variable or with block variable not set error
'DSAL Find Fails
sFilter = "#SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/userPropCheck" & Chr(34) & "= 'testing'" ''"#SQL=" & Chr$(34) & "http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/userPropCheck" & Chr(34) & " = 'testing'"
Set objc = dCalItems.Find(sFilter)
Debug.Print objc(1).ItemProperties.item("userPropCheck").Value 'ERROR: object variable or with block variable not set error
'THIS WORKS to filter the actual calendar view
Set objView = Application.ActiveExplorer.CurrentView
objView.Filter = Chr(34) & "http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/userPropCheck" & Chr(34) & "= 'testing'"
objView.Save
objView.Apply
End Sub
As you can see I am fairly lost. I can add a custom property to the item and then restrict on something other than that property to get the item and then print out the custom property, and I can filter the current view on the custom property using the DSAL view.Filter, but using that in the Restrict also does not work.
Related
I often need a search for all emails of a specific day. In order not to change the criteria of a search folder every time, I wrote a macro which creates a suitable search folder after asking for a date and displaying this folder.
Works fine, but whereas the search folder created the manual way within Outlook only lists the mails of this day, the programmed version also displays appointments of calendars of colleagues who shared their calendars with me - appointments and meetings which don't relate to me at all but were sent on that specific day.
The second thing, but a not important one is, that when displaying the properties of the created folder in Outlook the button for changing the criteria is disabled.
I think I need some additional filter criteria for method AdvancedSearch, but which ones?
At the moment, my code is as follows:
Sub CreateSearchFolderForDate()
'Creates a search folder for a specific date. Only the primarey exchange mailbox will be considered
'(no offline folders, no shared folders).
'The folder is displayed afterwards
Dim oSearch As Search
Dim oSearchFolder As Object
Dim strScope As String
Dim strFilter As String
Dim strDate1 As String
Dim strDate2 As String
Dim strInput As String
varInput = InputBox("Date?", "Create search order for a specific date", Date)
If Not IsDate(varInput) Then
Exit Sub
End If
'Delete existing folder first, otherwise there is a runtime error
Set oSearchFolder = GetSearchFolderByName("Mails for day X")
If Not oSearchFolder Is Nothing Then
oSearchFolder.Delete
End If
strScope = "'" & Application.Session.GetDefaultFolder(olFolderInbox).Parent.FolderPath & "'"
strFilter = "urn:schemas:mailheader:date >= '" & CDate(varInput) & "' AND urn:schemas:mailheader:date < '" & CDate(varInput) + 1 & "'"
Set oSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strFilter, SearchSubFolders:=True, Tag:="Mails of a specific date")
oSearch.Save ("Mails for day X")
Set oSearchFolder = GetSearchFolderByName("Mails for day X")
oSearchFolder.Display
End Sub
Function GetSearchFolderByName(strSearchFolderName As String) As Object
'Returns the search folder with the display name specified. Only the primarey exchange mailbox will be considered
'(no offline folders, no shared folders).
Dim oStore As Outlook.Store
Dim oFolder As Outlook.folder
On Error Resume Next
Set GetSearchFolderByName = Nothing
For Each oStore In Application.Session.Stores
If oStore.ExchangeStoreType = olPrimaryExchangeMailbox Then
For Each oFolder In oStore.GetSearchFolders
If oFolder.Name = strSearchFolderName Then
Set GetSearchFolderByName = oFolder
Exit Function
End If
Next
End If
Next
End Function
My idea was to use '''urn:schemas:calendar:dtstart'' as additional AND as for "normal" emails that should be empty and messed around a little bit with it - but either it had no effect or it resulted in a list containing only the undesired elements and no "normal" mails at all.
Attempts like IS NULL or IS NOT NULL in the filter caused VBA runtime errors.
In column "folder" the created search folder displays either the folder/subfolder my mails are stored in or for the unwanted entries a certain common part like Doe, Jane common_part and Doe, John common_part. But I didn't find a property which I could use as part of my filter ('''AND property NOT LIKE %common_part%''').
Any hint would be very much appreciated.
Regards,
Bootes
Update 2023-02-08: Before refactoring my problem using the hints and answers by #niton (thanks a lot for the patience) I will start a few more trys with AdvancedSearch, based on an analysis of a manually created search folder using the Redemption-Tool as developed by #Dmitry Streblechenko and described in his posting in How to get a search folder criteria in Outlook. The tool provided the following SQL-Statement:
((NOT (MessageClass LIKE 'IPM.Appointment%')) AND (NOT (MessageClass LIKE 'IPM.Contact%')) AND (NOT (MessageClass LIKE 'IPM.DistList%')) AND
(NOT (MessageClass LIKE 'IPM.Activity%')) AND
(NOT (MessageClass LIKE 'IPM.StickyNote%')) AND (NOT (MessageClass = 'IPM.Task'))
AND (NOT (MessageClass LIKE 'IPM.Task.%'))) AND
((("http://schemas.microsoft.com/mapi/proptag/0x0E090102" <> EF0000004B1E3AD5164F3F459BFE6A913D00E89042800000')
AND ("http://schemas.microsoft.com/mapi/proptag/0x0E090102" <> EF0000004B1E3AD5164F3F459BFE6A913D00E89022800000'))
AND ((SentOn < '2022-12-20') AND (SentOn >= '2022-12-19')))
I tried to translate this into VBA, but had no real success: If I use just the active lines, there is no effect at all, if I add the last two ones (formatted as comments below), I get error "Runtime error -2147023281 (8007064f) - Error during execution of operation" (re-translated from German to English):
strF = "urn:schemas:mailheader:date >= '" & CDate(strInput) & "' AND urn:schemas:mailheader:date < '" & CDate(strInput) + 1 & "' AND "
strF = strF & "NOT (urn:schemas:mailheader:content-class LIKE 'IPM.Appointment%') AND NOT (urn:schemas:mailheader:content-class LIKE 'IPM.Contact%') AND "
strF = strF & "NOT (urn:schemas:mailheader:content-class LIKE 'IPM.DistList%') AND NOT (urn:schemas:mailheader:content-class LIKE 'IPM.Activity%') AND "
strF = strF & "NOT (urn:schemas:mailheader:content-class LIKE 'IPM.StickyNote%') AND NOT (urn:schemas:mailheader:content-class = 'IPM.Task') AND "
strF = strF & "NOT (urn:schemas:mailheader:content-class LIKE 'IPM.Task.%')" ' AND "
'strF = strF & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0E090102" & Chr(34) & " <> 'EF0000004B1E3AD5164F3F459BFE6A913D00E89042800000'" ' AND "
'strF = strF & "(" & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0E090102" & Chr(34) & " <> 'EF0000004B1E3AD5164F3F459BFE6A913D00E89022800000')) AND "
The second approach could be the folder of the item as the unwanted ones are listed in column "In folder" with the folder name containing the a common part that is not in the folder name of the wanted items.
You can limit the search to the inbox.
strScope = "'" & Application.Session.GetDefaultFolder(olFolderInbox).folderPath & "'"
Advanced search is less capable than say .Restrict.
Delete items in Outlook by 'Type' or 'Message Class'
set restrictedItems = olSearchOlFolder.items.Restrict(" #SQL=""http://schemas.microsoft.com/mapi/proptag/0x001A001F"" LIKE 'IPM.Schedule.Meeting.%' ")
how to apply filter only on outlook messages using vba
oFilter2 = "[MessageClass] = 'IPM.Note'"
This is a theoretical implementation of "urn:schemas:mailheader:content-class", that may be applicable, from https://learn.microsoft.com/en-us/previous-versions/office/developer/exchange-server-2007/aa579702(v=exchg.80)
Private Sub AdvSearch_URN_Test()
Dim strSearch As String
Dim strDASLFilter As String
Dim strScope As String
Dim objSearch As Search
Dim strDASLFilter_option As String
Dim fldrNm As String
strScope = "'" & Session.GetDefaultFolder(olFolderInbox).Parent.folderPath & "'"
Debug.Print strScope
' https://learn.microsoft.com/en-us/previous-versions/office/developer/exchange-server-2007/aa579702(v=exchg.80)
' **** most options do nothing ****
' displayto & fromemail are functional
' search by displayto
strSearch = "to display name"
strDASLFilter_option = "displayto"
' These fail
'strDASLFilter_option = "sender" 'search by Sender
'strDASLFilter_option = "sendername" 'search by senderName
'strDASLFilter_option = "senderemail" 'search by SenderEmail
' search by content-class
' *** This fails ***
strSearch = "IPM.Note"
strDASLFilter_option = "content-class"
strDASLFilter = "urn:schemas:httpmail:" & strDASLFilter_option & " LIKE '%" & strSearch & "%'"
Debug.Print strDASLFilter
Set objSearch = AdvancedSearch(Scope:=strScope, filter:=strDASLFilter, SearchSubFolders:=True, Tag:="SearchFolder")
'Save the search results to a searchfolder
fldrNm = strDASLFilter_option & " " & strSearch
Debug.Print fldrNm
objSearch.Save fldrNm
Debug.Print fldrNm & " saved."
End Sub
I have everything working to send an email via an Access command button. However, the displayed email address is incorrect.
Private Sub cmdSendEmail_Click()
Dim EmailApp, NameSpace, EmailSend As Object
Set EmailApp = CreateObject("Outlook.Application")
Set NameSpace = EmailApp.GetNamespace("MAPI")
Set EmailSend = EmailApp.CreateItem(0)
EmailSend.To = [emailadd] '[emailadd] is the field on the form where the button is located
EmailSend.Subject = [Forms]![WorkordersVR]![Project] & " - " & [Forms]![WorkordersVR]![JobNumber]
EmailSend.Body = "Hello," & vbCrLf & vbCrLf & _
"The project" & " " & [Forms]![WorkordersVR]![Project] & " " & "is ready for pickup." & vbCrLf & vbCrLf & _
"Thank you!" & vbCrLf & vbCrLf & _
"Person sending email here" & vbCrLf & _
EmailSend.Display
Set EmailApp = Nothing
Set NameSpace = Nothing
Set EmailSend = Nothing
End Sub
What ends up in the displayed email To is:
"fred#aplace.com#fred#aplace.com#"
How do I get fred#aplace.com?
You can use string functions available in VBA to get a substring until the # symbol in the string. For example, the InStr function returns a number specifying the position of the first occurrence of one string within another.
Also I'd suggest using the Recipients property of the MailItem class which returns a Recipients collection that represents all the recipients for the Outlook item. Then I'd suggest using the Recipient.Resolve method which attempts to resolve a Recipient object against the Address Book.
For example:
Sub CreateStatusReportToBoss()
Dim myItem As Outlook.MailItem
Dim myRecipient As Outlook.Recipient
Set myItem = Application.CreateItem(olMailItem)
Set myRecipient = myItem.Recipients.Add("email")
myRecipient.Resolve
If(myRecipient.Resolved) Then
myItem.Subject = "Status Report"
myItem.Display
End If
End Sub
I am trying to cycle through specific appointments of the current day and display their details in a msgbox.
I found out about DASL filter queries.
However, it only brings up the first appointment it finds. The FindNext method never steps to the next appointment, even though it came from an example I found on the web doing something very similar.
When I set the same DASL filter directly in Outlook, it shows the appointments as expected.
Here is my current sub:
Sub GetAppointments()
Dim sFilter As String
Dim oExplorer As Outlook.Explorer
Dim oFolder As Outlook.Folder
Dim oAppointment As Outlook.AppointmentItem
sFilter = "#SQL=" & _
"%today(""urn:schemas:calendar:dtstart"")% AND " & _
"%today(""urn:schemas:calendar:dtend"")% AND " & _
"""urn:schemas-microsoft-com:office:office#Keywords"" LIKE '%Meeting%'"
Set oExplorer = Application.ActiveExplorer
Set oFolder = oExplorer.CurrentFolder
Set oAppointment = oFolder.Items.Find(sFilter)
While TypeName(oAppointment) <> "Nothing"
MsgBox oAppointment.Subject & vbCr & _
oAppointment.Start & vbCr & _
oAppointment.End
Set oAppointment = oFolder.Items.FindNext
Wend
End Sub
You need to deal with the same Items collection if you want to get more results:
Dim appItems as Outlook.Items
Set appItems = oFolder.Items
Set oAppointment = appItems.Find(sFilter)
While TypeName(oAppointment) <> "Nothing"
MsgBox oAppointment.Subject & vbCr & _
oAppointment.Start & vbCr & _
oAppointment.End
Set oAppointment = appItems.FindNext
Wend
When you ask the Items property from a folder, a new Items instance is returned so further FindNext calls don't make any sense.
Read more about the Find/FindNext methods in the following articles:
How To: Retrieve Outlook calendar items using Find and FindNext methods
How To: Use Restrict method in Outlook to get calendar items
Also you may want to include recurrence occurrences, in that case you need to set up a corresponding property on the Items collection:
Dim appItems as Outlook.Items
Set appItems = oFolder.Items
appItems.Sort "[Start]"
appItems.IncludeRecurrences = True
Set oAppointment = appItems.Find(sFilter)
While TypeName(oAppointment) <> "Nothing"
MsgBox oAppointment.Subject & vbCr & _
oAppointment.Start & vbCr & _
oAppointment.End
Set oAppointment = appItems.FindNext
Wend
The property returns a Boolean that indicates True if the Items collection should include recurrence patterns.
This property only has an effect if the Items collection contains appointments and is not sorted by any property other than Start in ascending order. The default value is False. Use this property when you want to retrieve all appointments for a given date, where recurring appointments would not normally appear because they are not associated with any specific date. If you need to sort and filter on appointment items that contain recurring appointments, you must do so in this order: sort the items in ascending order, set IncludeRecurrences to True, and then filter the items.
I try to find a folder in an Outlook account (I use Multiple accounts) using VBA and Redemption by using the FIND method but I cannot get it to work. On the Redemption webpage there is a reference made to an example and this may help but unfortunately the example isn't there.
Here's my code so far:
Public Function FindFolderRDO(strCrit As String) As String
If Not TempVars![appdebug] Then On Error GoTo Err_Proc
Dim objRdoSession As Redemption.RDOSession
Dim objRdoFolder As RDOFolder
Dim strFoundFolder As String
Dim objFoundFolder As RDOFolder
Dim strFolderName As String
Set objRdoSession = CreateObject("Redemption.RDOSession")
objRdoSession.Logon
objRdoSession.MAPIOBJECT = Outlook.Session.MAPIOBJECT
strFolderName = "\\[mailbox name]\[foldername]\[foldername]" 'actual names removed
Set objRdoFolder = objRdoSession.GetFolderFromPath(strFolderName)
Debug.Print objRdoFolder.Parent.Name 'Prints the folder name
Set objFoundFolder = objRdoFolder.Folders.Find("LIKE 'strCrit%' ") 'Does not work
Debug.Print objFoundFolder.Name
strFoundFOlder = objRdoFolder.Folders.Find("LIKE 'strCrit%' ") 'Does not work
Debug.Print strFoundFOlder
Exit_Proc:
On Error Resume Next
Set objRdoFolder = Nothing
Set objRdoSession = Nothing
Set objFoundFolder = Nothing
Exit Function
Err_Proc:
Select Case Err.Number
Case Else
MsgBox "Error: " & CStr(Err.Number) & vbCrLf & _
"Desc: " & Err.Description & vbCrLf & vbCrLf & _
"Source: " & Err.Source & vbCrLf & _
"Library: " & Application.CurrentProject.Name & vbCrLf & _
"Module: Mod_RDO" & vbCrLf & _
"Function: FindFolderRDO" & vbCrLf, _
vbCritical, "Error"
End Select
Resume Exit_Proc
End Function
Purpose of this function is to find a subfolder (can be up to 4 dimensions deep) having an unique case number of 6 numbers (for example "200332") on the first 6 positions. This function should provide NULL if not found or the full path and the name of the found folder.
I can create the full path with a seperate function (calling the parent folder until top level) but maybe there is a procedure in Redemption such as "fullpath" which I overlooked.
Eventually I want to use this function to delete, move or rename the mailbox folder.
My main question is how to use the "Find(Filter)" method. But any reply on the full path is welcome as well.
Thx! Art.
You are you trying to find a suborder with a name that starts with "strCrit"?
You are almost there:
Set objFoundFolder = objRdoFolder.Folders.Find("Name LIKE 'strCrit%' ")
Preface: I'm very much a dabbler at coding, and I'm not surprised my current code doesn't work, but I can't figure out whether I'm trying an approach that is fundamentally not possible or whether I just don't understand the correct syntax. Unlike the majority of the rest of my current project code, I haven't yet found the solution in the many other posts here.
Context: Playing Elite: Dangerous. I have a list of star systems in an Excel worksheet with each row containing one system (columns: name, x, y, z coordinates, and some properties such as Visited, RareGoodsSource). I've created a StarSystem class and read the worksheet into a Collection of StarSystems (named colSys). This works. For each property of the class I have a separate worksheet (columns: name, property) where I manually adjust property values (e.g. just visited Tau Ceti in game, on worksheet "csvVisited" manually add row "Tau Ceti", "TRUE"). In VBA I then compare those to the values in the Collection elements and update the latter if necessary. (Eventually I pump all this stuff to AutoCAD to visualise and plan travel routes.)
Issue: I currently have a separate Sub for each property, identical except for the name of the worksheet (e.g. "csvVisited" / "csvRareGoodsSource") and the references to access the property (e.g. colSys.Item(r.Value).Visited / colSys.Item(r.Value).RareGoodsSource). This works. But it seems Wrong from the perspectives of aesthetics, efficiency, and maintenance. Surely I should have only one Sub, which I pass Visited or RareGoodsSource as required?
My current code for this generic sub is at the end of the post, first I have an extremely abstracted version for clarity. My first attempt was to simply literally replace Visited with strProperty everywhere in the Sub, and pass Visited or RareGoodsSource to the Sub into that string variable.
This works fine for the worksheet reference, presumably because .Item() requires a string anyway. I am not entirely surprised it does not work for the property reference, because I'm passing a string variable in the hopes VBA understands this as an object property name, but I have been unable to find how one should do this. Hopefully it's just a result of my embarrassing lack of basic programming knowledge, and I just need some brackets or quotes or &'s somewhere.
Simplified example code, which works correctly (...except the bit that doesn't, obviously):
Sub TestVisited()
Call TestGeneric("Visited")
End Sub
Sub TestGeneric(strProperty As String)
Dim wsCSV As Worksheet
Set wsCSV = ActiveWorkbook.Worksheets.Item("csv" & strProperty)
'successfully sets wsCSV to Worksheets.Item("csvVisited"),
'presumably because .Item() expects a string anyway.
Dim r As Range
For Each r In wsCSV.Range(wsCSV.Cells(2, 1), wsCSV.Cells(4, 1))
Debug.Print "Explicitly coded: " & colSys.Item(r.Value).Visited
Debug.Print "Passed as string: " & colSys.Item(r.Value).strProperty
Next r
'The first Debug.Print works, the second does not:
'"Object doesn't support this property or method."
End Sub
The current real code for context:
(Note I've disabled the error trap on the .Contains replacement, because otherwise that would trap this problem instead.)
Sub UpdatePropertyFromWorksheetCSVProperty(strProperty As String)
'set the cell column/row positions in Worksheets.
Let celCSVDataColumn = 2
'prepare reference to Worksheet to read.
Dim wsCSV As Worksheet
Set wsCSV = ActiveWorkbook.Worksheets.Item("csv" & strProperty)
'prepare reference to Range to read.
Dim rngData As Range
Set rngData = wsCSV.Range(wsCSV.Cells(celFirstDataRow, celKeyColumn), wsCSV.Cells( _
wsCSV.Cells(wsCSV.Rows.Count, celKeyColumn).End(xlUp).Row _
, celKeyColumn)) ' middle segment finds the last occupied cell in column A and returns its row index.
'for each Worksheet row, compare the property value in the Worksheet to the value in the Collection Element,
'if different write the Worksheet value to the Collection Element, and flag the Element as ModifiedSinceRead.
Dim r As Range
For Each r In rngData
'check Sytem exists in the Collection.
'except VBA Collections don't have a .Contains method apparently.
'use error trapping instead.
'On Error GoTo ErrorHandler
'compare/copy Worksheet and Collection values.
If Not colSys.Item(r.Value).strProperty = r.Offset(0, celCSVDataColumn - 1).Value Then
On Error GoTo 0 'disables error trap again.
Let colSys.Item(r.Value).strProperty = r.Offset(0, celCSVDataColumn - 1).Value
Let colSys.Item(r.Value).xlsModifiedSinceRead = True
'DEBUG: test to immediate window
Debug.Print "System " & colSys.Item(r.Value).Name & " " & strProperty & " property changed to " & colSys.Item(r.Value).strProperty & "."
'
End If
ResumeNextSystem:
Next r
'DEBUG: test to immediate window
Debug.Print colSys(1).Name & vbTab & colSys(1).x & vbTab & colSys(1).RareGoodsSource & vbTab & colSys(1).RareGoodsChecked & vbTab & colSys(1).Visited & vbTab & colSys(1).xlsModifiedSinceRead
Debug.Print colSys(10160).Name & vbTab & colSys(10160).x & vbTab & colSys(10160).RareGoodsSource & vbTab & colSys(10160).RareGoodsChecked & vbTab & colSys(10160).Visited & vbTab & colSys(10160).xlsModifiedSinceRead
Debug.Print colSys("Lave").Name & vbTab & colSys("Lave").x & vbTab & colSys("Lave").RareGoodsSource & vbTab & colSys("Lave").RareGoodsChecked & vbTab & colSys("Lave").Visited & vbTab & colSys("Lave").xlsModifiedSinceRead
'
Exit Sub
ErrorHandler:
MsgBox ("Processing Worksheet " & wsCSV.Name & " error at system " & r.Value & ", skipping to next.")
'DEBUG: test to immediate window
Debug.Print "Processing Worksheet " & wsCSV.Name & " error at system " & r.Value & ", skipping to next."
'
Resume ResumeNextSystem
End Sub
Solution in real code:
'stays as-is:
Set wsCSV = ActiveWorkbook.Worksheets.Item("csv" & strProperty)
'Get old:
If Not colSys.Item(r.Value).strProperty = r.Offset(0, celCSVDataColumn - 1).Value Then
'new:
If Not CallByName(colSys.Item(r.Value), strProperty, VbGet) = r.Offset(0, celCSVDataColumn - 1).Value Then
'Let old:
Let colSys.Item(r.Value).strProperty = r.Offset(0, celCSVDataColumn - 1).Value
'new:
CallByName colSys.Item(r.Value), strProperty, VbLet, r.Offset(0, celCSVDataColumn - 1).Value
You can use CallByName built-in function to get the property.
v = CallByName(colSys.Item(r.Value), strProperty, vbGet)
This KB article explains it: https://support.microsoft.com/kb/186143