Home > Archive > Visual Basic > August 2005 > speeding up process from frontend to backend
You are viewing an archived Text-only version of the thread.
To view this thread in it's original format and/or if you want to reply to
this thread please [click here]
| Author |
speeding up process from frontend to backend
|
|
|
| using the following code to loop through all the contacts in MS outlook,
check them individually with an MS access DB on the backend and then make
changes to them if needed. HOwever, this process is quite slow. With 50
contacts it takes ~3.5seconds to go through all of them and make changes.
Can anyone see where i can speed this up......or suggest any better
suggestions to do this?
Private Function AllidsinOutLook(stempGlobal)
Dim ol As Outlook.Application
Dim olns As NameSpace
Dim objContactsFolder As Outlook.MAPIFolder
Dim iCount As Integer
Dim objContacts As Outlook.Items
Dim objContact As Object
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set objContactsFolder = olns.Folders("FOLDER").Folders("FolderTest")
Set objContacts = objContactsFolder.Items
objContacts.SetColumns "Customer ID"
iCount = 0
For Each objContact In objContacts
stempGlobal = objContact.UserProperties("Customer ID")
Call ReverseCOMDatabaseCheck(stempGlobal)
iCount = iCount + 1
Next
Set objContact = Nothing
Set objContacts = Nothing
Set objContactsFolder = Nothing
End Function
Private Function ReverseCOMDatabaseCheck(stempGlobal)
Dim ol As Outlook.Application
Dim olns As NameSpace
Dim ptContact As Object
Dim oChild3 As Outlook.MAPIFolder 'Folder
Dim myContact As Object
Dim menu As Object
Dim Command As Object
Dim conConnection As New ADODB.Connection
Dim cmdCommand As New ADODB.Command
Dim rstRecordSet As New ADODB.Recordset
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set oChild3 = olns.Folders("FOLDER").Folders("FolderTest")
conConnection.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=" & _
strDBLocationOL & ";Persist Security Info=False"
conConnection.CursorLocation = adUseClient
conConnection.Open
'Defines our command object
With cmdCommand
.ActiveConnection = conConnection
.CommandText = "Select * from TABLE1 Where [CUST_ID] = " & stempGlobal
.CommandType = adCmdText
End With
With rstRecordSet
.CursorType = adOpenStatic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open cmdCommand
End With
If rstRecordSet.EOF = False Then
'Move to the first record
rstRecordSet.MoveFirst
Do
If rstRecordSet.Fields(1) = 1 Then
Set ptContact = oChild3.Items.Find("[CUstomerID] = " & stempGlobal)
With ptContact
'update everything
.Save
End With
End If
'Move to the next record
rstRecordSet.MoveNext
Loop Until rstRecordSet.EOF = True
Else
Call DeleteContact(stempGlobal) 'Deletes Contact
End If
'Close the recordset but not the connection
rstRecordSet.Close
conConnection.Close
'Release your variable references
Set conConnection = Nothing
Set cmdCommand = Nothing
Set rstRecordSet = Nothing
End Function
| |
|
| Why post another thread on the same subject. Respond in your original post.
--
Chris Hanscom - Microsoft MVP (VB)
Veign's Resource Center
http://www.veign.com/vrc_main.asp
--
"pb" <pb@discussions.microsoft.com> wrote in message
news:A1C60DF3-9683-4F5D-B81D-40A924D3F1B4@microsoft.com...
> using the following code to loop through all the contacts in MS outlook,
> check them individually with an MS access DB on the backend and then make
> changes to them if needed. HOwever, this process is quite slow. With 50
> contacts it takes ~3.5seconds to go through all of them and make changes.
> Can anyone see where i can speed this up......or suggest any better
> suggestions to do this?
>
> Private Function AllidsinOutLook(stempGlobal)
>
> Dim ol As Outlook.Application
> Dim olns As NameSpace
> Dim objContactsFolder As Outlook.MAPIFolder
> Dim iCount As Integer
> Dim objContacts As Outlook.Items
> Dim objContact As Object
>
> Set ol = New Outlook.Application
> Set olns = ol.GetNamespace("MAPI")
> Set objContactsFolder = olns.Folders("FOLDER").Folders("FolderTest")
> Set objContacts = objContactsFolder.Items
>
> objContacts.SetColumns "Customer ID"
>
> iCount = 0
> For Each objContact In objContacts
> stempGlobal = objContact.UserProperties("Customer ID")
> Call ReverseCOMDatabaseCheck(stempGlobal)
> iCount = iCount + 1
> Next
>
> Set objContact = Nothing
> Set objContacts = Nothing
> Set objContactsFolder = Nothing
> End Function
>
> Private Function ReverseCOMDatabaseCheck(stempGlobal)
> Dim ol As Outlook.Application
> Dim olns As NameSpace
> Dim ptContact As Object
> Dim oChild3 As Outlook.MAPIFolder 'Folder
> Dim myContact As Object
> Dim menu As Object
> Dim Command As Object
> Dim conConnection As New ADODB.Connection
> Dim cmdCommand As New ADODB.Command
> Dim rstRecordSet As New ADODB.Recordset
>
> Set ol = New Outlook.Application
> Set olns = ol.GetNamespace("MAPI")
> Set oChild3 = olns.Folders("FOLDER").Folders("FolderTest")
>
> conConnection.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data
> Source=" & _
> strDBLocationOL & ";Persist Security Info=False"
>
> conConnection.CursorLocation = adUseClient
> conConnection.Open
>
> 'Defines our command object
> With cmdCommand
> .ActiveConnection = conConnection
> .CommandText = "Select * from TABLE1 Where [CUST_ID] = " & stempGlobal
> .CommandType = adCmdText
> End With
>
> With rstRecordSet
> .CursorType = adOpenStatic
> .CursorLocation = adUseClient
> .LockType = adLockOptimistic
> .Open cmdCommand
> End With
>
> If rstRecordSet.EOF = False Then
>
> 'Move to the first record
> rstRecordSet.MoveFirst
> Do
>
> If rstRecordSet.Fields(1) = 1 Then
>
> Set ptContact = oChild3.Items.Find("[CUstomerID] = " & stempGlobal)
> With ptContact
> 'update everything
> .Save
> End With
> End If
> 'Move to the next record
> rstRecordSet.MoveNext
> Loop Until rstRecordSet.EOF = True
>
> Else
> Call DeleteContact(stempGlobal) 'Deletes Contact
> End If
>
> 'Close the recordset but not the connection
> rstRecordSet.Close
> conConnection.Close
>
> 'Release your variable references
> Set conConnection = Nothing
> Set cmdCommand = Nothing
> Set rstRecordSet = Nothing
>
> End Function
| |
|
| its the database processing part is taking a while, not the searching through
outlook part
"Veign" wrote:
> Why post another thread on the same subject. Respond in your original post.
>
> --
> Chris Hanscom - Microsoft MVP (VB)
> Veign's Resource Center
> http://www.veign.com/vrc_main.asp
> --
>
>
> "pb" <pb@discussions.microsoft.com> wrote in message
> news:A1C60DF3-9683-4F5D-B81D-40A924D3F1B4@microsoft.com...
>
>
>
| |
|
| Why not open a Recordset of all Customer ID and keep it open during the
whole process of checking ID against the Outlook contacts.
You could, to help speed things up, is open the recordset and create an
array of ID's to check against - this way you could close the recordset and
connection as you only need to perform the check and not writing anything
back out.
This way you can loop through the Outlook contacts and perform the
comparison against your array and no longer are required to open the
database connection / recordset....
--
Chris Hanscom - Microsoft MVP (VB)
Veign's Resource Center
http://www.veign.com/vrc_main.asp
--
"pb" <pb@discussions.microsoft.com> wrote in message
news:102B9EED-10A4-43BF-818F-A4DFCD35DBCE@microsoft.com...
> its the database processing part is taking a while, not the searching
through[color=darkred]
> outlook part
>
>
> "Veign" wrote:
>
post.[color=darkred]
outlook,[color=darkred]
make[color=darkred]
50[color=darkred]
changes.[color=darkred]
"Provider=Microsoft.Jet.OLEDB.4.0;Data[color=darkred]
stempGlobal[color=darkred]
stempGlobal)[color=darkred]
| |
|
| I'm not too familiar with arrays. But, i've managed to do the following. I
think, here, i'm loading all the customer id's into 1 array and the
SETASDIRTY into anther array; SETASDIRTY is either 0 or 1; if its 1, then i
should go ahead and update the outlook contact, if 0, then don't do anything;
thats why i'm loading 2 columns. Can i just put both columns into 1 array
with 2 columns?...if so..how would i change the following. Once i've
determined what i need, how do i search through the array, using if
array(value) = custID from outlook.....then......something like that?.....
Dim rsTemp As Variant, rstemp2 As Variant, lngUBound1 As Long, lngUBound2 As
Long
Dim iRow As Long, iCol As Long
'get into var
rsTemp = a.Recordset.GetRows(, adBookmarkFirst, "CUST_ID")
rstemp2 = a.Recordset.GetRows(, adBookmarkFirst, "SETASDIRTY")
lngUBound1 = UBound(rsTemp, 2)
lngUBound2 = UBound(rsTemp, 1)
For iRow = 0 To lngUBound1
For iCol = 0 To lngUBound2
msgbox rsTemp(iCol, iRow)
msgbox rstemp2(iCol, iRow)
Next iCol
Next iRow
| |
|
| i've changed this so i can get a different row with only 1 recordset to, this
looks more efficient; also created a listbox 1 and 2 to see what values are
being generated, all i need now i to know how to compare the values of the
array to a number:
rsTemp = a.Recordset.GetRows
lngUBound1 = UBound(rsTemp, 2)
For iRow = 0 To lngUBound1
List1.AddItem rsTemp(0, iRow) 'CUSTOMER ID ROW from Db
List2.AddItem rsTemp(1, iRow) 'SETASDIRTY ROW from db
Next iRow
| |
|
| OK.....seems like i'm the only repsonding to my own messages:, but i've got
the following....this takes on average 1.89 seconds.......can the below be
refined even more?
Dim rsTemp As Variant, rstemp2 As Variant, rstemp3 As Variant, lngUBound1 As
Long, lngUBound2 As Long
Dim iRow As Long, iCol As Long
Dim tmrStart As Long
Dim a As New ADODB.Connection
Dim cmdCommand As New ADODB.Command
Dim rstRecordSet As New ADODB.Recordset
Dim ol As Outlook.Application
Dim olns As NameSpace
Dim objContactsFolder As Outlook.MAPIFolder
Dim iCount As Integer
Dim objContacts As Outlook.Items
Dim objContact As Object
Dim stester1 As String
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set objContactsFolder = olns.Folders("FOLDER).Folders("foldertest")
Set objContacts = objContactsFolder.Items
With a
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source = " & _
strDBLocationOL & ";Persist Security Info=False"
.CursorLocation = adUseClient
.Open
End With
With cmdCommand
.ActiveConnection = a
.CommandText = "Select * from TABLE"
.CommandType = adCmdText
End With
With rstRecordSet
.CursorType = adOpenStatic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open cmdCommand
End With
tmrStart = Timer
rsTemp = rstRecordSet.GetRows
lngUBound1 = UBound(rsTemp, 2)
objContacts.SetColumns "Customer ID"
iCount = 0
For Each objContact In objContacts
stester1 = objContact.UserProperties("Customer ID")
For iRow = 0 To lngUBound1
If rsTemp(0, iRow) = stester1 Then
''''MsgBox "match" & rsTemp(0, iRow)
End If
Next iRow
iCount = iCount + 1
Next
MsgBox FormatNumber((Timer - tmrStart), 2) & " secs", vbExclamation, "timer"
a.Close
rstRecordSet.Close
rsTemp = Nothing
Set objContact = Nothing
Set objContacts = Nothing
Set objContactsFolder = Nothing
| |
|
| "pb" <pb@discussions.microsoft.com> wrote in message
news:FDD5EC29-B339-4C3D-9CD4-1C8BCE52E44B@microsoft.com...
> OK.....seems like i'm the only repsonding to my own messages:, but i've
got
> the following....this takes on average 1.89 seconds.......can the below be
> refined even more?
>
> Dim rsTemp As Variant, rstemp2 As Variant, rstemp3 As Variant, lngUBound1
As
Don't use variants. If they arrays of longs or strings make then that.
Dim rsTemp() As String
> Long, lngUBound2 As Long
> Dim iRow As Long, iCol As Long
> Dim tmrStart As Long
> Dim a As New ADODB.Connection
> Dim cmdCommand As New ADODB.Command
> Dim rstRecordSet As New ADODB.Recordset
> Dim ol As Outlook.Application
> Dim olns As NameSpace
> Dim objContactsFolder As Outlook.MAPIFolder
> Dim iCount As Integer
> Dim objContacts As Outlook.Items
> Dim objContact As Object
Don't use an object type, use an Outlook.Contact data type
> Dim stester1 As String
>
> Set ol = New Outlook.Application
> Set olns = ol.GetNamespace("MAPI")
> Set objContactsFolder = olns.Folders("FOLDER).Folders("foldertest")
> Set objContacts = objContactsFolder.Items
>
> With a
> .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source = "
& _
> strDBLocationOL & ";Persist Security Info=False"
> .CursorLocation = adUseClient
> .Open
> End With
>
> With cmdCommand
> .ActiveConnection = a
> .CommandText = "Select * from TABLE"
Instead of using SELECT * use SELECT [fieldnames] and list the fields you
want returned.
> .CommandType = adCmdText
> End With
> With rstRecordSet
> .CursorType = adOpenStatic
> .CursorLocation = adUseClient
> .LockType = adLockOptimistic
> .Open cmdCommand
> End With
If you are only reading the recordset then use a firehose recordset which is
ForwardOnly, ReadOnly
>
> tmrStart = Timer
>
> rsTemp = rstRecordSet.GetRows
> lngUBound1 = UBound(rsTemp, 2)
>
> objContacts.SetColumns "Customer ID"
>
> iCount = 0
> For Each objContact In objContacts
> stester1 = objContact.UserProperties("Customer ID")
> For iRow = 0 To lngUBound1
> If rsTemp(0, iRow) = stester1 Then
> ''''MsgBox "match" & rsTemp(0, iRow)
If there was macth is there any need to continue the loop?
Add an Exit For here if you no longer need to cycle through the inner loop
once a match is found
> End If
> Next iRow
> iCount = iCount + 1
> Next
> MsgBox FormatNumber((Timer - tmrStart), 2) & " secs", vbExclamation,
"timer"
>
> a.Close
> rstRecordSet.Close
> rsTemp = Nothing
>
> Set objContact = Nothing
> Set objContacts = Nothing
> Set objContactsFolder = Nothing
There will be some delays when working with Outlook and the Outlook library
to cycle through the contacts...
--
Chris Hanscom - Microsoft MVP (VB)
Veign's Resource Center
http://www.veign.com/vrc_main.asp
--
| |
|
| Thanks Chris,
I get an "Expected Array" compile error when i changed
Dim rstemp as string or rstemp as integer
On this line:
lngUBound1 = UBound(rsTemp, 2)
Also, would it help, if i stored the loop where i go through the outlook
folder as an array?
| |
|
| You need to define them as arrays of Strings or Integers:
Dim rstemp() as string or rstemp() as integer
(notice the parenthesis)
--
Chris Hanscom - Microsoft MVP (VB)
Veign's Resource Center
http://www.veign.com/vrc_main.asp
--
"pb" <pb@discussions.microsoft.com> wrote in message
news:4F123C05-C150-4701-A770-948F7D4C6A05@microsoft.com...
> Thanks Chris,
>
> I get an "Expected Array" compile error when i changed
> Dim rstemp as string or rstemp as integer
>
> On this line:
> lngUBound1 = UBound(rsTemp, 2)
>
> Also, would it help, if i stored the loop where i go through the outlook
> folder as an array?
| |
|
| Type mismatch error on line:
rsTemp = rstRecordSet.GetRows
when defining them as rstemp() as string or rstemp() as integer
1 database field is AutoNumbered, 1 is Number, and the rest are text
"Veign" wrote:
> You need to define them as arrays of Strings or Integers:
> Dim rstemp() as string or rstemp() as integer
>
> (notice the parenthesis)
>
>
> --
> Chris Hanscom - Microsoft MVP (VB)
> Veign's Resource Center
> http://www.veign.com/vrc_main.asp
> --
>
>
> "pb" <pb@discussions.microsoft.com> wrote in message
> news:4F123C05-C150-4701-A770-948F7D4C6A05@microsoft.com...
>
>
>
|
|
|
|
|