Hi Everybody
This is very surprising - can someone help me please, desperately!
I am using Excel as the interface using VBA to do the following - I am creating an MS Access database on the fly and creating a couple of table therein. These tables are populated by executing 2 queries on an SQL server database. So far so good.
I then build an SQL statement and try to execute it - it complains that the "Weekday" function used in the SQL is not a built-in function and stops execution. However, the exact same SQL when copied and pasted in SQL View in the front end Access, it executes perfectly.
I have checked that this "Weekday" is available both in front end and VBA for Access as a built-in function. Why does it then complain?
Any suggestions, how can I get around to this problem?
The code so far is shown below (the username and the password has been removed) :-
[vba]
Sub CreateDatabaseAndTables()
Dim adoxCatalog As ADOX.Catalog
Dim adoCN As ADODB.Connection
Dim dbConnectStr As String, dbName As String, tableName As String
Dim pathtoTextFile As String, pathtoMDB As String
Dim rs As ADODB.Recordset
Dim recCount As Long, fieldCount As Long
Dim recordCountStart As Long, recordCountWrkg As Long
Dim adoxTable As ADOX.Table
Dim start As Long, wrkg As Long
Dim startTime As Long, finishTime As Long, totalTime As Long
startTime = Timer
dbName = "C:\SourceDataDB.mdb"
On Error Resume Next
Kill dbName
On Error GoTo 0
dbConnectStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbName & ";"
Set adoxCatalog = New ADOX.Catalog
adoxCatalog.Create dbConnectStr
'Set adoCN = New Connection
Set adoxTable = New ADOX.Table
tableName = "ReportingScope"
With adoxTable
.Name = tableName
.Columns.Append "ITEM_CODE"
.Columns.Append "ITEM_DESCRIPTION"
.Columns.Append "ITEM_TYPE"
.Columns.Append "FUNCTIONAL_GROUP"
.Columns.Append "FUNCTIONAL_AREA"
.Columns.Append "QUARANTINED"
End With
adoxCatalog.Tables.Append adoxTable
'A table with hard coded field names has now been created and appended to the catalog in the code above.
Dim adoNewConn As ADODB.Connection
Dim rsTable As ADODB.Recordset
Dim rsTableSQL As String
Set rsTable = New Recordset
rsTableSQL = "Select * from " & tableName
Set adoNewConn = New Connection
With adoNewConn
.Provider = "Microsoft.Jet.OLEDB.4.0": .ConnectionString = dbName: .Open
End With
rsTable.Open rsTableSQL, adoNewConn, adOpenKeyset, adLockOptimistic
'Connection to the SANDPIT AND USER SQL Server databases on the GLAWI048 server is being established here
'The reporting scope table is being read and a table in Access database is being populated here
dbConnectStr = ""
Dim sqlString As String
dbConnectStr = "Provider=SQLOLEDB.1;User ID = "removed"; password = "removed"; initial Catalog = BACKLOG_DEV_USERS; Data Source=GLAWI048;"
Set adoCN = New Connection
adoCN.Open dbConnectStr
sqlString = ""
sqlString = sqlString & "select ITEM_CODE, ITEM_DESCRIPTION, ITEM_TYPE, FUNCTIONAL_GROUP, FUNCTIONAL_AREA, QUARANTINED from dbo.SW_BPEM_REPORTING_SCOPE"
Set rs = New Recordset
rs.Open sqlString, adoCN, adOpenKeyset, adLockOptimistic, adCmdText
recCount = rs.RecordCount
fieldCount = rs.Fields.Count
rs.MoveFirst
Dim fieldCountStart As Long, fieldCountWrkg As Long
fieldCountStart = 0: recordCountStart = 0: recordCountWrkg = recordCountStart
rs.MoveFirst
Do While Not rs.EOF
rsTable.AddNew
fieldCountWrkg = fieldCountStart
Do While fieldCountWrkg < fieldCount
rsTable.Fields(fieldCountWrkg) = rs.Fields(fieldCountWrkg)
fieldCountWrkg = fieldCountWrkg + 1
Loop
rs.MoveNext
recordCountWrkg = recordCountWrkg + 1
Loop
rsTable.UpdateBatch
rs.Close
Set rs = Nothing
rsTable.Close
Set rsTable = Nothing
'Getting data from SANDPIT for BPEM's and WI's and storing the resultset as table
Set adoxTable = New ADOX.Table
tableName = "BPEMAndWI"
With adoxTable
.Name = tableName
.Columns.Append "ID", adDouble
.Columns.Append "STATUS"
.Columns.Append "ITEM_CODE"
.Columns.Append "CREATED_DATE", adDate
.Columns("CREATED_DATE").Attributes = adColNullable
.Columns.Append "CHANGED_DATE", adDate
.Columns("CHANGED_DATE").Attributes = adColNullable
End With
adoxCatalog.Tables.Append adoxTable
'A table with hard coded field names has now been created and appended to the catalog in the code above.
Set rsTable = New Recordset
rsTableSQL = "Select * from " & tableName
Set adoNewConn = New Connection
With adoNewConn
.Provider = "Microsoft.Jet.OLEDB.4.0": .ConnectionString = dbName: .Open
End With
rsTable.Open rsTableSQL, adoNewConn, adOpenKeyset, adLockOptimistic
'Connection to the SANDPIT AND USER SQL Server databases on the GLAWI048 server is being established here
'The reporting scope table is being read and a table in Access database is being populated here
' Dim cmd As New ADODB.Command
' Set cmd.ActiveConnection = adoCN
' cmd.CommandText = "select count(*) from dbo.BUT000"
' cmd.CommandType = adCmdText
'Set rs = cmd.Execute
dbConnectStr = ""
dbConnectStr = "Provider=SQLOLEDB.1;User ID = "removed"; password = "removed"; initial Catalog = BACKLOG_DEV_SANDPIT; Data Source=GLAWI048;"
Set adoCN = New Connection
adoCN.Open dbConnectStr
Dim thisDate As Date, thisDay As Long, nextThursdayDate As Date, earliestDate As Date
thisDate = Now()
thisDay = Weekday(Now(), 2)
If thisDay <= 4 Then
nextThursdayDate = (Now() + 4 - Weekday(Now(), 2))
Else
nextThursdayDate = (Now() + 4 + 7 - Weekday(Now(), 2))
End If
earliestDate = (nextThursdayDate - 91 + 1) 'This translates a 13 weeks or a quarter - each weeking ending on a Thursday inclusive of this week
sqlString = ""
sqlString = sqlString & "select CASENR AS ID, STATUS = CASE WHEN STATUS = '1' THEN 'NEW' WHEN STATUS = '2' THEN 'iN_PROCESS' "
sqlString = sqlString & "WHEN STATUS = '3' THEN 'COMPLETED' WHEN STATUS = '4' THEN 'CANCELLED' WHEN STATUS = '6' THEN 'CONFIRMED' END, "
sqlString = sqlString & "CCAT As ITEM_CODE, CREATED_DATE, CHANGED_DATE "
sqlString = sqlString & "from BACKLOG_DEV_SANDPIT.dbo.EMMA_CASE "
sqlString = sqlString & "where (CREATED_DATE <= '" & Format(nextThursdayDate, "yyyy-mm-dd") & "' and CREATED_DATE >= '" & Format(earliestDate, "yyyy-mm-dd") & "') or "
sqlString = sqlString & "(CHANGED_DATE <= '" & Format(nextThursdayDate, "yyyy-mm-dd") & "' and CHANGED_DATE >= '" & Format(earliestDate, "yyyy-mm-dd") & "') "
sqlString = sqlString & "union "
sqlString = sqlString & "select WI_ID AS ID, WI_STAT AS STATUS, WI_RH_TASK AS ITEM_CODE, WI_CD AS CREATED_DATE, WI_AED AS CHANGED_DATE "
sqlString = sqlString & "from BACKLOG_DEV_SANDPIT.dbo.SWWWIHEAD "
sqlString = sqlString & "where (WI_CD <= '" & Format(nextThursdayDate, "yyyy-mm-dd") & "' and WI_CD >= '" & Format(earliestDate, "yyyy-mm-dd") & "') or "
sqlString = sqlString & "(WI_AED <= '" & Format(nextThursdayDate, "yyyy-mm-dd") & "' and WI_AED >= '" & Format(earliestDate, "yyyy-mm-dd") & "') "
Set rs = New Recordset
rs.Open sqlString, adoCN, adOpenKeyset, adLockOptimistic, adCmdText
recCount = rs.RecordCount
fieldCount = rs.Fields.Count
rs.MoveFirst
fieldCountStart = 0: recordCountStart = 0: recordCountWrkg = recordCountStart
rs.MoveFirst
Do While Not rs.EOF
rsTable.AddNew
fieldCountWrkg = fieldCountStart
Do While fieldCountWrkg < fieldCount
rsTable.Fields(fieldCountWrkg) = rs.Fields(fieldCountWrkg)
fieldCountWrkg = fieldCountWrkg + 1
Loop
rs.MoveNext
recordCountWrkg = recordCountWrkg + 1
Loop
rsTable.UpdateBatch
rs.Close
Set rs = Nothing
rsTable.Close
Set rsTable = Nothing
'Works upto here with the Reporting Scope and the relevant data having been extracted from the SQL Server databases and populated in to Access database tables
'Adding Access queries here to generate the various summarized datasets for BPEM's and WI's to be used to generate XML files for feed to Xcelsius
'COMPLETEDANDCANCELLED QUERY
sSQL_1 = ""
sSQL_1 = sSQL_1 & "SELECT ReportingScope.QUARANTINED, ReportingScope.FUNCTIONAL_GROUP, ReportingScope.FUNCTIONAL_AREA, BPEMAndWI.STATUS, "
sSQL_1 = sSQL_1 & "IIf(Application.Weekday([CHANGED_DATE],2)<=4,([CHANGED_DATE]+4-Application.Weekday([CHANGED_DATE],2)),([CHANGED_DATE]+4+7-Application.Weekday([CHANGED_DATE],2))) AS Wk_Ending, "
sSQL_1 = sSQL_1 & "Count(BPEMAndWI.ID) AS CountOfID "
sSQL_1 = sSQL_1 & "FROM BPEMAndWI INNER JOIN ReportingScope ON BPEMAndWI.ITEM_CODE = ReportingScope.ITEM_CODE "
sSQL_1 = sSQL_1 & "WHERE (((BPEMAndWI.CHANGED_DATE) <> #12/31/9999#)) "
sSQL_1 = sSQL_1 & "GROUP BY ReportingScope.QUARANTINED, ReportingScope.FUNCTIONAL_GROUP, ReportingScope.FUNCTIONAL_AREA, BPEMAndWI.STATUS, "
sSQL_1 = sSQL_1 & "IIf(Application.Weekday([CHANGED_DATE],2)<=4,([CHANGED_DATE]+4-Application.Weekday([CHANGED_DATE],2)),([CHANGED_DATE]+4+7-Application.Weekday([CHANGED_DATE],2))) "
sSQL_1 = sSQL_1 & "HAVING (((BPEMAndWI.Status) = 'COMPLETED' Or (BPEMAndWI.Status) = 'CANCELLED')) "
sSQL_1 = sSQL_1 & "ORDER BY ReportingScope.QUARANTINED, ReportingScope.FUNCTIONAL_GROUP, ReportingScope.FUNCTIONAL_AREA, BPEMAndWI.STATUS, "
sSQL_1 = sSQL_1 & "IIf(Application.Weekday([CHANGED_DATE],2)<=4,([CHANGED_DATE]+4-Application.Weekday([CHANGED_DATE],2)),([CHANGED_DATE]+4+7-Application.Weekday([CHANGED_DATE],2))), BPEMAndWI.STATUS;"
finalSQL = sSQL_1
Debug.Print finalSQL
Set rs = New Recordset
'COMPLAINS HERE
rs.Open finalSQL, adoCN, adOpenKeyset, adLockOptimistic, adCmdText
recCount = rs.RecordCount: fieldCount = rs.Fields.Count
fieldCountStart = 0: recordCountStart = 0: recordCountWrkg = recordCountStart
rs.MoveFirst
Dim myarray() As Variant
ReDim myarray((recCount - 1), (fieldCount - 1)) As Variant
Do While Not rs.EOF
fieldCountWrkg = fieldCountStart
Do While fieldCountWrkg < fieldCount
If IsNull(rs.Fields(fieldCountWrkg)) Then
myarray(recordCountWrkg, fieldCountWrkg) = ""
Else
myarray(recordCountWrkg, fieldCountWrkg) = rs.Fields(fieldCountWrkg)
End If
fieldCountWrkg = fieldCountWrkg + 1
Loop
rs.MoveNext
recordCountWrkg = recordCountWrkg + 1
Loop
[/vba]
Best regards
Deepak Agarwal
Reply With Quote
