Understanding Complex (for me at least) VB Code in Access

[John Ortt]

Hi Everyone,

I have inherrited a database which makes use of VB code to perform a stage
of the weekly update.

The update works effectively but I have now been tasked with reducing the
amount of time it takes and the code section is by far the longest process.

I have tried to add comments to the code within my understanding but if
anybody can spot errors in my comments, or can think of a better/more
efficient way of performing the same task I would be very grateful.

Thanks in advance,

John

CODE FOLLOWS
/////////////////////////////

Function Update_Details_With_COOP_Data()

' This query updates the Details Table with the latest info from the Coop
Purchase Orders Table where there is a firm order date

Dim MyDB As Database, Import_Query As Recordset, MyWrk As Workspace
Dim strSQL As String, Coop_SQL As String, COOP_Data As Recordset
Set MyWrk = DBEngine.Workspaces(0)
Set MyDB = CurrentDb
strSQL = "SELECT * FROM Details_Table" ' Defines the variable strSQL
Set Import_Query = MyDB.OpenRecordset(strSQL) ' Selects all the records
from the Details Table and stores the data as Import_Query
With Import_Query ' Using the data for Import Query
..MoveFirst ' Move to the first line of data
Do Until .EOF ' Repeat the following code until it reaches the end of the
form (EOF)
Coop_SQL = "SELECT * FROM COOP_Purchase_Orders_Table WHERE
[COL_Link] =""" & Import_Query![Col_link] & """ ORDER BY [Firm_Date]"
' Select the lines in the "COOP_Purchase_Orders_Table" where the
"COL_Link" matches with the "Import_Query"
Set COOP_Data = MyDB.OpenRecordset(Coop_SQL)
If COOP_Data.RecordCount > 0 Then ' If there is a match then do the
following, otherwise go straight to the "End If"
.Edit
![AQUISITION] = COOP_Data![AQUISITION]
If COOP_Data![Firm_Date] <> "" Then ![Firm_Date] =
COOP_Data![Firm_Date]
![PO_Number] = COOP_Data![PO_Number]
![System] = COOP_Data![System]
![MMS_Link] = COOP_Data![MMS_Link]
.Update
End If

.MoveNext
Loop
End With
DoEvents
End Function

 

[Douglas J. Steele]

It would appear to be returning a recordset consisting of every record in
Details_Table and looking at each record one at a time. For each record, it
checks to see whether there's a record in COOP_Purchase_Orders_Table that
has the same COL_Link value as the current record in Details_Table. If there
is a match, it updates the values of AQUISITION, PO_Number, System and
MMS_Link in Details_Table to be the same as in COOP_Purchase_Orders_Table.
It also updates Firm_Date in Details_Table to be the same as in
COOP_Purchase_Orders_Table if there is a date there.

I'm not surprised it takes a while: it's almost always significantly faster
simply to use an Update query rather than VBA code to do something like
this. Try:

Dim MyDB As Database
Dim strSQL As String

strSQL = "UPDATE Details_Table LEFT JOIN " & _
"COOP_Purchase_Orders_Table " & _
"ON Details_Table.COL_Link = " & _
"COOP_Purchase_Orders_Table.COL_Link " & _
"SET Details_Table.[AQUISITION] = COOP_Data.[AQUISITION], " & _
"Details_Table.[PO_Number] = COOP_Data.[PO_Number], " & _
"Details_Table.[System] = COOP_Data.[System], " & _
"Details_Table.[MMS_Link] = COOP_Data.[MMS_Link], " & _
"Details_Table.[Firm_Date] = COOP_Data.[Firm_Date]"

Set MyDb = CurrentDb()
MyDB.Execute strSQL, dbFailOnError


--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)

Hi Everyone,

I have inherrited a database which makes use of VB code to perform a stage
of the weekly update.

The update works effectively but I have now been tasked with reducing the
amount of time it takes and the code section is by far the longest process.

I have tried to add comments to the code within my understanding but if
anybody can spot errors in my comments, or can think of a better/more
efficient way of performing the same task I would be very grateful.

Thanks in advance,

John

CODE FOLLOWS
/////////////////////////////

Function Update_Details_With_COOP_Data()

' This query updates the Details Table with the latest info from the Coop
Purchase Orders Table where there is a firm order date

Dim MyDB As Database, Import_Query As Recordset, MyWrk As Workspace
Dim strSQL As String, Coop_SQL As String, COOP_Data As Recordset
Set MyWrk = DBEngine.Workspaces(0)
Set MyDB = CurrentDb
strSQL = "SELECT * FROM Details_Table" ' Defines the variable strSQL
Set Import_Query = MyDB.OpenRecordset(strSQL) ' Selects all the records
from the Details Table and stores the data as Import_Query
With Import_Query ' Using the data for Import Query
.MoveFirst ' Move to the first line of data
Do Until .EOF ' Repeat the following code until it reaches the end of the
form (EOF)
Coop_SQL = "SELECT * FROM COOP_Purchase_Orders_Table WHERE
[COL_Link] =""" & Import_Query![Col_link] & """ ORDER BY [Firm_Date]"
' Select the lines in the "COOP_Purchase_Orders_Table" where the
"COL_Link" matches with the "Import_Query"
Set COOP_Data = MyDB.OpenRecordset(Coop_SQL)
If COOP_Data.RecordCount > 0 Then ' If there is a match then do the
following, otherwise go straight to the "End If"
.Edit
![AQUISITION] = COOP_Data![AQUISITION]
If COOP_Data![Firm_Date] <> "" Then ![Firm_Date] =
COOP_Data![Firm_Date]
![PO_Number] = COOP_Data![PO_Number]
![System] = COOP_Data![System]
![MMS_Link] = COOP_Data![MMS_Link]
.Update
End If

.MoveNext
Loop
End With
DoEvents
End Function

 

[Andi Mayer]

Dim MyDB As Database
Dim strSQL As String

strSQL = "UPDATE Details_Table LEFT JOIN " & _
"COOP_Purchase_Orders_Table " & _
"ON Details_Table.COL_Link = " & _
"COOP_Purchase_Orders_Table.COL_Link " & _
"SET Details_Table.[AQUISITION] = COOP_Data.[AQUISITION], " & _
"Details_Table.[PO_Number] = COOP_Data.[PO_Number], " & _
"Details_Table.[System] = COOP_Data.[System], " & _
"Details_Table.[MMS_Link] = COOP_Data.[MMS_Link], " & _
"Details_Table.[Firm_Date] = COOP_Data.[Firm_Date]"

Set MyDb = CurrentDb()
MyDB.Execute strSQL, dbFailOnError

Douglas you missed the if statement:

If COOP_Data![Firm_Date] <> "" Then ![Firm_Date] =
COOP_Data![Firm_Date]


"Details_Table.[Firm_Date] = " _
&"IIf (COOP_Data![Firm_Date] <> '', " _
&"COOP_Data.[Firm_Date],Details_Table.[Firm_Date])"

 

[John Ortt]

Thankyou for the replies guys. I think I understand what you are getting
at.

I am going to try the new code for the update query in place of the old code
and see if it improves matters.

Thanks again,

John

 

[Douglas J. Steele]

Dim MyDB As Database
Dim strSQL As String

strSQL = "UPDATE Details_Table LEFT JOIN " & _
"COOP_Purchase_Orders_Table " & _
"ON Details_Table.COL_Link = " & _
"COOP_Purchase_Orders_Table.COL_Link " & _
"SET Details_Table.[AQUISITION] = COOP_Data.[AQUISITION], " & _
"Details_Table.[PO_Number] = COOP_Data.[PO_Number], " & _
"Details_Table.[System] = COOP_Data.[System], " & _
"Details_Table.[MMS_Link] = COOP_Data.[MMS_Link], " & _
"Details_Table.[Firm_Date] = COOP_Data.[Firm_Date]"

Set MyDb = CurrentDb()
MyDB.Execute strSQL, dbFailOnError

Douglas you missed the if statement:

If COOP_Data![Firm_Date] <> "" Then ![Firm_Date] =
COOP_Data![Firm_Date]


"Details_Table.[Firm_Date] = " _
&"IIf (COOP_Data![Firm_Date] <> '', " _
&"COOP_Data.[Firm_Date],Details_Table.[Firm_Date])"

Actually, I left it out deliberately, since it wasn't clear to me what
Firm_Date was. I suppose I should have commented on it.

If it's a date field, comparing it to '' is meaningless (dates are numeric,
not text).

An IIf statement requires 3 parts: the boolean comparison, the value to use
if the boolean comparison is true and the value to use if the boolean
comparison is false. Since I didn't know what value was wanted in the table
if the date was '', I couldn't use an IIf statement.

To fully replicate the VBA code, I guess it should be:

Dim MyDB As Database
Dim strSQL As String

Set MyDb = CurrentDb()

strSQL = "UPDATE Details_Table LEFT JOIN " & _
"COOP_Purchase_Orders_Table " & _
"ON Details_Table.COL_Link = " & _
"COOP_Purchase_Orders_Table.COL_Link " & _
"SET Details_Table.[AQUISITION] = COOP_Data.[AQUISITION], " & _
"Details_Table.[PO_Number] = COOP_Data.[PO_Number], " & _
"Details_Table.[System] = COOP_Data.[System], " & _
"Details_Table.[MMS_Link] = COOP_Data.[MMS_Link], " & _
"Details_Table.[Firm_Date] = COOP_Data.[Firm_Date] " & _
"WHERE COOP_Data.[Firm_Date] <> ''"

MyDB.Execute strSQL, dbFailOnError

strSQL = "UPDATE Details_Table LEFT JOIN " & _
"COOP_Purchase_Orders_Table " & _
"ON Details_Table.COL_Link = " & _
"COOP_Purchase_Orders_Table.COL_Link " & _
"SET Details_Table.[AQUISITION] = COOP_Data.[AQUISITION], " & _
"Details_Table.[PO_Number] = COOP_Data.[PO_Number], " & _
"Details_Table.[System] = COOP_Data.[System], " & _
"Details_Table.[MMS_Link] = COOP_Data.[MMS_Link] " & _

"WHERE COOP_Data.[Firm_Date] = ''"

MyDB.Execute strSQL, dbFailOnError

 

[John Ortt]

Hi Doug.

The Firm_Date field is listed as a Date/Time field but aside from that there
are no validation rules, default values, formatting or Input masks in place.

I believe the author was trying to discern whether the field was blank or
otherwise. The only reason I can see for using the "" instead of a null, is
that the source file is imported from a text file and it is possible that
blank entries were imported as spaces instead of nulls......but I have yet
to investigate this.

Thanks again for taking the time to look at it,

John

Dim MyDB As Database
Dim strSQL As String

strSQL = "UPDATE Details_Table LEFT JOIN " & _
"COOP_Purchase_Orders_Table " & _
"ON Details_Table.COL_Link = " & _
"COOP_Purchase_Orders_Table.COL_Link " & _
"SET Details_Table.[AQUISITION] = COOP_Data.[AQUISITION], "

&

_

"Details_Table.[PO_Number] = COOP_Data.[PO_Number], " & _
"Details_Table.[System] = COOP_Data.[System], " & _
"Details_Table.[MMS_Link] = COOP_Data.[MMS_Link], " & _
"Details_Table.[Firm_Date] = COOP_Data.[Firm_Date]"

Set MyDb = CurrentDb()
MyDB.Execute strSQL, dbFailOnError

Douglas you missed the if statement:

If COOP_Data![Firm_Date] <> "" Then ![Firm_Date] =
COOP_Data![Firm_Date]


"Details_Table.[Firm_Date] = " _
&"IIf (COOP_Data![Firm_Date] <> '', " _
&"COOP_Data.[Firm_Date],Details_Table.[Firm_Date])"

Actually, I left it out deliberately, since it wasn't clear to me what
Firm_Date was. I suppose I should have commented on it.

If it's a date field, comparing it to '' is meaningless (dates are numeric,
not text).

An IIf statement requires 3 parts: the boolean comparison, the value to use
if the boolean comparison is true and the value to use if the boolean
comparison is false. Since I didn't know what value was wanted in the table
if the date was '', I couldn't use an IIf statement.

To fully replicate the VBA code, I guess it should be:

Dim MyDB As Database
Dim strSQL As String

Set MyDb = CurrentDb()

strSQL = "UPDATE Details_Table LEFT JOIN " & _
"COOP_Purchase_Orders_Table " & _
"ON Details_Table.COL_Link = " & _
"COOP_Purchase_Orders_Table.COL_Link " & _
"SET Details_Table.[AQUISITION] = COOP_Data.[AQUISITION], " & _
"Details_Table.[PO_Number] = COOP_Data.[PO_Number], " & _
"Details_Table.[System] = COOP_Data.[System], " & _
"Details_Table.[MMS_Link] = COOP_Data.[MMS_Link], " & _
"Details_Table.[Firm_Date] = COOP_Data.[Firm_Date] " & _
"WHERE COOP_Data.[Firm_Date] <> ''"

MyDB.Execute strSQL, dbFailOnError

strSQL = "UPDATE Details_Table LEFT JOIN " & _
"COOP_Purchase_Orders_Table " & _
"ON Details_Table.COL_Link = " & _
"COOP_Purchase_Orders_Table.COL_Link " & _
"SET Details_Table.[AQUISITION] = COOP_Data.[AQUISITION], " & _
"Details_Table.[PO_Number] = COOP_Data.[PO_Number], " & _
"Details_Table.[System] = COOP_Data.[System], " & _
"Details_Table.[MMS_Link] = COOP_Data.[MMS_Link] " & _

"WHERE COOP_Data.[Firm_Date] = ''"

MyDB.Execute strSQL, dbFailOnError

 

[Douglas J. Steele]

If it's a Date/Time field, there is no way is will ever have spaces,
regardless of its origin. A Date/Time field in a table can have a Null value
if it's set up with its Required property set to False (No). Otherwise, it
must be numeric. Date/Time fields are 8 byte floating point numbers, where
the integer part represents the date as the number of days relative to 30
Dec, 1899 and the decimal part represents the time as a fraction of day.