I wrote this code that seeks for a particular string in all messages within all mailboxes (average of 100 mesages per mailbox (10 mailboxes total)).
The thing is... the code works but it is too damn slow, even freezes Outlook.
Is there something I can do to make it faster?
Sub InboxSeeker(Word As String)
Dim u As Integer, AddressArr() As String, Users() As String, Element As Variant, Label As Control
GetOutlook
AddressArr = QryLoop_Specific("Company", "Address", "Users", "Team", "Samples", "Address")
For Each Element In AddressArr
Set lFolder = GetFolder(Element)
Set lItems = GetFolder(Element).Items
For Each lMsg In lItems
If InStr(1, lMsg.Body, Word, vbTextCompare) > 0 Or InStr(1, lMsg.Subject, Word, vbTextCompare) > 0 Then
DoEvents
ReDim Preserve Users(u)
Users(u) = QrySingleResult("Company", "FullName", "Users", "Address", Element)
u = u + 1
End If
Next lMsg
Next Element
I am not fully sure why you need DoEvents at each iterations, but you might need it in your GUI, otherwise just do it once at the end.
I believe that ReDim of the array all the time is not very efficient. Why not using a Collection?
Collections vs Array
You could change your code to include
Dim Users as new Collection
...
Users.Add QrySingleResult("Company", "FullName", "Users", "Address", Element)
For Each Element In AddressArr
Set lFolder = GetFolder(Element)
Set lItems = GetFolder(Element).Items
For Each lMsg In lItems
Instead of iterating over all folders and items in Outlook you need to use the Find/FindNext or Restrict methods of the Items class to find Outlook items that matches your conditions.
Also I'd suggest using the AdvancedSearch method of the Namespace class which performs a search based on a specified DAV Searching and Locating (DASL) search string.
Use Items.Find/FindNext
set item = lItems.Find("#SQL=(""urn:schemas:httpmail:textdescription"" LIKE '%something%') OR (""http://schemas.microsoft.com/mapi/proptag/0x0E1D001F"" LIKE '%something%') ")
while Not (item is Nothong)
...
set Item = lItems.FindNext
wend
Related
I've seen answers to questions similar to this one, but I haven't been able to find anything that addresses this exact situation.
Goal: Populate a list box and/or a worksheet with the output of a HypQueryMembers function. For example, I would like to get a list of the descendants of account 10100 without having to perform an ad hoc query and zoom in. I know how to get the return code, e.g. 0 if successful, but I want the actual output. I found some code that populated a list box, but I haven't been able to get it to work for me. I receive the error "Could not set the List property. Invalid property array index." My code follows:
Sub TestQueryMbrs()
Dim X As Integer
Dim arrAccounts
X = HypQueryMembers(Empty, "10100", HYP_DESCENDANTS, Empty, Empty, Empty, Empty, arrAccounts)
If X <> 0 Then
MsgBox "Unable to populate members." & vbCr & vbCr & "Error: " & X, vbCritical + vbOKOnly
Else
UserForm2.ListBox1.List = arrAccounts
UserForm2.Show
End If
End Sub
Any idea what I'm doing wrong? Also, I would like to accomplish the same thing, but populate a worksheet rather than a list box. But one step at a time!
Thanks!
Is 10100 the genuine name of the field? I suspect by you calling it account that 10100 should be replaced by Account instead as that parameter seems to be limited to the field name rather than an individual member. However, I have yet to determine how to get descendents of a particular account/cost centre so your way may be the correct way to do this.
I'd suggest trying that change to just "Account" though and then try adding as variant to Dim arrAccounts and then deleting Dim arrAccounts altogether if that doesn't work.
You may also not be able to populate the listbox before Userform2 is shown? You could wrap application.screenupdating =FALSE then TRUE around the Userform2 changes so the user doesn't see the list box being populated if there is a lag.
I had the same issue today and ran across this post - I realize it's years old...
Oracle's documentation on this function is a bit confusing... at least the example they used at the bottom of the page: https://docs.oracle.com/cd/E72988_01/DGSMV/ch12s15.html
For example, you need to enter the integer value for HYP_DESCENDANTS, which is 2 instead of the text shown in your code.
The following is a good snippet of code to verify your array:
Declare PtrSafe Function HypQueryMembers Lib "HsAddin" (ByVal vtSheetName As Variant, ByVal vtMemberName As Variant, ByVal vtPredicate As Variant, ByVal vtOption As Variant, ByVal vtDimensionName As Variant, ByVal vtInput1 As Variant, ByVal vtInput2 As Variant, ByRef vtMemberArray As Variant) As Long
Sub Example_HypQueryMembers()
sts = HypQueryMembers("INSERT WORKSHEET NAME HERE", "INSERT SMARTVIEW MEMBER HERE", 1, Empty, Empty, Empty, Empty, vArray)
If IsArray(vArray) Then
cbItems = UBound(vArray) + 1
MsgBox ("Number of elements = " + Str(cbItems))
For i = 0 To UBound(vArray)
MsgBox ("Member = " + vArray(i))
Next
Else
MsgBox ("Return Value = " + Str(vArray))
End If
End Sub
I would like to sort the field values (strings) by their frequency in lotusscript.
Has anyone an idea to solve this?
Thanks a lot.
Personally I would avoid LotusScript if you can help it. You are going to run into limitations that cannot be worked around.
Regardless of which route you do take, from a performance point of view it is better to have the View indexes do the work.
So you would create a view. The first column would be as follows.
Column Value: The field you want to check.
Sort: Ascending
Type: Categorized
After this you can access the data using the NotesViewNavigator. The related method call is getNextCategory. This will give you a view entry object which you can call ChildCount on to get totals.
For example (Disclaimer: Code written from memory, not guaranteed to run):
Dim sess As New NotesSession
Dim db As NotesDatabase
Dim vw As NotesView
Dim nav as NotesViewNavigator
Dim entryA As NotesViewEntry
Dim entryB As NotesViewEntry
Set db = sess.CurrentDatabase
Set vw = db.GetView("testView")
vw.AutoUpdate = False
Set nav = vw.CreateViewNav
Set entryA = nav.GetFirst
while entryA not Nothing
Set entryB = nav.GetNextCategory(entryA)
if entryB not nothing then
' Do your processing.
' entryB.childCount will give total.
end if
set EntryA = EntryB
Wend
view.AutoUpdate = True
This way the heavy lifting (string sorting, counting) is handled by the View index. So you only need to process the final results.
To answer the op's (old) question directly, the way to do this in LotusScript is both simple and easy:
dim para as string
dim words as variant
dim fq list as long
'get the text to freq-count
para = doc.text '(or $ from somewhere)
'tidy up para by removing/replacing characters you don't want
para = replace(para, split(". , : ; - [ ] ()"), "")
words = split(para) 'or split(words, "delim") - default is space
forall w in words
if iselement(words(w)) then
fq(w) = fq(w) + 1
Else
fq(w) = 1
End forall
'you now have a count of each individual word in the FQ list
'to get the words out and the word frequencies (not sorted):
forall x in fq
print listtag(x) = x
End forall
Thats it. No issue with LotusScript - quick and easy (and lists can be massive). To get a sorted list, you would have to move to an array and do a sort on it or move to a field and let #sort do the job somehow.
I have a questions about classic ASP:
Can anyone tell me what I am doing wrong in this snippet? If ORDERDATA() contains one entry only, it works fine. If more than one, it crashes. I am pretty sure it has to do with the Dim/ReDim of the CARTITEMS() variable, but I can't see what I'm doing wrong.
Some of the dimmed variables are used in other parts of the script, please ignore them.
Dim i,countOrderRows, orderdata, XXX
orderdata = Order_GetOrderData()
countOrderRows = ubound(orderdata,1)
Dim cartItems()
ReDim cartItems(countOrderRows-1)
Dim goodsList(), addr, klarnaresponse, resp, sql, item
ReDim goodsList(countOrderRows-1)
for i = 0 to countOrderRows - 1
Set item = Server.CreateObject("Scripting.Dictionary")
item.Add "reference", "XX1"
item.Add "name", orderdata(i,2)
item.Add "quantity", cint(orderdata(i,5))
item.Add "unit_price", (cint(orderdata(i,3)*100))
item.Add "discount_rate", 0
item.Add "tax_rate", 2500
Set cartItems(i) = item
Set item = nothing
next
Hope you guys can help!
Regards, Bob
countOrderRows = ubound(orderdata,1)
assigns the maximum 0-based index to countOrderRow, not the number of elements.
Later, you use countOrderRows as if it contained the number of elements:
ReDim cartItems(countOrderRows-1)
For an orderdata with only one element in dimension 1, this will do ReDim (..,-1), which is not what you intended, but hey!
Well, why this doesn't yield an error is a separate question ;)
And then, you use
for i = 0 to countOrderRows-1
to iterate. That´s wrong. UBound returns the maximum acceptable index. For one element, this is 0. Since countOrderRows equals 0, you are trying a
for i = 0 to -1
which again is not what you intended.
And that´s why things work (seem to work) for only one element: A for loop from 0 to -1 is executed zero times. If there is more than one element, the loop code is executed, and fails due to the wrong indexes and array sizes involved.
Note I intentionally did not just spit out corrected code, but tried to lead you into fixing this bug yourself.
Assuming that Order_GetOrderData() is a multidimensional array in the format
function Order_GetOrderData ()
dim myArray(0,5)
myArray(0, 0) = "XX1"
myArray(0, 1) = "G66T"
myArray(0, 2) = "An Item"
myArray(0, 3) = "3"
myArray(0, 4) = "0"
myArray(0, 5) = "100"
Order_GetOrderData = myArray
end function
Removing the -1 from countOrderRows in all three places it's used allowed me to return the item values for each iteration.
Dim i,countOrderRows, orderdata, XXX
orderdata = Order_GetOrderData()
countOrderRows = ubound(orderdata, 1)
Dim cartItems()
ReDim cartItems(countOrderRows)
Dim goodsList(), addr, klarnaresponse, resp, sql, item
ReDim goodsList(countOrderRows)
for i = 0 to countOrderRows
Set item = Server.CreateObject("Scripting.Dictionary")
item.Add "reference", "XX1"
item.Add "name", orderdata(i,2)
item.Add "quantity", cint(orderdata(i,5))
item.Add "unit_price", (cint(orderdata(i,3)*100))
item.Add "discount_rate", 0
item.Add "tax_rate", 2500
Set cartItems(i) = item
Set item = nothing
next
response.write cartItems(0).item("name")
response.write cartItems(1).item("name")
etc.
The reason for this being that ubound(orderdata, 1) returns the number of rows in a ZERO based form so subtracting 1 from this gave a negative value when only one result existed.
I am unsure why your code works when you pass it one item and not multiple items. The example provided using my assumed data works with multiple items as long as you are looking to return from the beginning of the data set, but will always fail if only one item is returned. It may have something to do with the format of the array returned by Order_GetOrderData()?
I am using the following VBA Macro to delete all the pictures in a PowerPoint slide:
Public Function delete_slide_object(slide_no)
' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
' Delete object in slide
Set PPSlide = PPPres.Slides(slide_no)
For Each PPShape In PPSlide.Shapes
If PPShape.Type = msoPicture Then
PPShape.Delete
End If
Next PPShape
Set PPShape = Nothing
Set PPSlide = Nothing
Set PPPres = Nothing
End Function
This code is deleting some but not all the pictures.After running this code 3 times , all the pictures get deleted. Where am i going wrong? Kindly let me know
When deleting items from a collection, you have to use a different iteration.
Try this:
Dim p as Long
For p = PPSlide.Shapes.Count to 1 Step -1
Set PPShape = PPSlide.Shapes(p)
If PPShape.Type = msoPicture Then PPShape.Delete
Next
This is because the collection is re-indexed when items are removed, so if you delete Shapes(2) then what was previously Shapes(3) becomes Shapes(2) after the deletion, and is effectively "skipped" by the loop. To avoid this, you have to start with the last shape, and delete them in reverse order.
I am working with VBA in Excel to retrieve some information from the Reuters 3000 Database. The data I retrieve comes as a bidimensional array consisting of one column holding dates and other column holding numeric values.
After I retrieve the information, a process that takes no more than 2 seconds, I want to write this data to a worksheet. In the worksheet I have a column with dates and several other columns with numeric values, each column containing values of a same category. I iterate over the rows of the array to get the date and numeric value and I keep those in a variable, then I search for the date on the date column of the worksheet and after I've found the date I write the value. Here is my code:
Private Sub writeRetrievedData(retrievedData As Variant, dateColumnRange As String, columnOffset As Integer)
Dim element As Long: Dim startElement As Long: Dim endElement As Long
Dim instrumentDate As Variant: Dim instrumentValue As Variant
Dim c As Variant: Dim dateCellAddress As Variant
Application.ScreenUpdating = False
Sheets("Data").Activate
startElement = LBound(retrievedData, 1): endElement = UBound(retrievedData, 1)
Application.DisplayStatusBar = True
Application.StatusBar = "Busy writing data to worksheet"
For element = startElement To endElement
instrumentDate = retrievedData(element, 1): instrumentValue = retrievedData(element, 2)
Range(dateColumnRange).Select
Set c = Selection.Find(What:=instrumentDate, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
c.offset(0, columnOffset).Value = instrumentValue
End If
Next element
Application.DisplayStatusBar = False
End Sub
My problem is that this process is very slow, even if I have only 5 rows in the array it takes about 15 seconds to complete the task. As I want to repeat this process several times (once per each set of data I retrieve from the database), I would like to decrease the execution time as much as possible.
As you can see, I am disabling the update of the screen, which is one of the most recurrent actions to improve performance. Does anybody have a suggestion on how I can further decrease the execution time?
PS. I know the data retrieval process does not take much because I already tested that part (displaying values on a MsgBox as soon as the data has been retrieved)
Thanks in advanced.
This is what I did to improve the performance:
Avoid selecting the cell when the value is going to be written. This was a suggestion of Tim Williams.
I set the property Application.Calculation to xlCalculationManual
Instead of using the Find() function to search for the date, I loaded all the dates from the worksheet into an array and iterate over this array to get the row number. This turns out to be faster than the Find() function.
Private Function loadDateArray() As Variant
Dim Date_Arr() As Variant
Sheets("Data").Activate
Date_Arr = Range(Cells(3, 106), Cells(3, 106).End(xlDown))
loadDateArray = Date_Arr
End Function
Private Function getDateRow(dateArray As Variant, dateToLook As Variant)
Dim i As Double: Dim dateRow As Double
For i = LBound(dateArray, 1) To UBound(dateArray, 1)
If dateArray(i, 1) = dateToLook Then
dateRow = i
Exit For
End If
Next i
getDateRow = dateRow
End Function
Thank you all for your help!
By not selecting the sheet, you can add a bit more speed. Instead of
Sheets("Data").Activate
Date_Arr = Range(Cells(3, 106), Cells(3, 106).End(xlDown))
loadDateArray = Date_Arr
Try
With Sheets("Data")
Date_Arr = .Range(Cells(3, 106), Cells(3, 106).End(xlDown))
End With