I'm having a syntax issue with using DCount to test the results of a query in an external database. I get the "Run-time Error 2001: You cancelled the previous operation."
In a nutshell the module runs 70 queries in 40 databases by looping a recordset that has the queries and databases. If the query isn't empty and has less than 1000 records, TransferSpreadsheet to a common Excel file for reporting purposes. The queries themselves are in the external databases.
Here's the complete module:
Private Sub cmd_RunReport_Click()
Dim strProgressMessage As String
Dim DB As Database
Dim RS As Recordset
Dim strDBtoOpen As String
Dim strDatabase As String
Dim strOpenQuery As String
Dim strResults As String
Dim appAccess As Access.Application
Dim intCounter As Integer
Dim intTestEmpty As Integer
Dim strQField As String
Dim strDoNotTest As String
Dim intResponse As Integer
Set RS = CurrentDb.OpenRecordset("tbl_Qlist_Queries")
intCount = 0
strProgressMessage = ""
strResults = "{UNC to the target Excel for TransferSpreadsheet}"
strQField = "Search_NameLast"
Do While Not RS.EOF
strDBtoOpen = RS!Path & "\" & RS!File
strDatabase = RS!File
strOpenQuery = RS!Query
strDoNotTest = RS!DoNotTest
Set DB = DBEngine.OpenDatabase(strDBtoOpen)
Set appAccess = New Access.Application
If strDoNotTest = "True" Then
appAccess.OpenCurrentDatabase strDBtoOpen
appAccess.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strOpenQuery, strResults, -1
Else
appAccess.OpenCurrentDatabase strDBtoOpen
'<Right Here>
intTestEmpty = Nz(appAccess.DCount(strQField, strOpenQuery), 0)
If intTestEmpty > 0 Then
If intTestEmpty < 1000 Then
appAccess.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strOpenQuery, strResults, -1
Else
intResponse = MsgBox(Prompt:="Query " & strRunQueries & " contains " & intTestEmpty _
& " records." & vbCrLf & "Do you still want to export?", Buttons:=vbYesNo)
If intRepsonse = vbYes Then
appAccess.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strOpenQuery, strResults, -1
End If
End If
End If
End If
appAccess.CloseCurrentDatabase
Set DB = Nothing
intCounter = intCounter + 1
Me.tbx_Progress.Value = intCounter & " Query = " & strOpenQuery
Me.Repaint
RS.MoveNext
MsgBox ("Pause, CTRL+BREAK to Cancel")
Loop
End Sub
Thanks a bazillion and I bow down to you "I am not worthy."
Rob
In a nutshell the module runs 70 queries in 40 databases by looping a recordset that has the queries and databases. If the query isn't empty and has less than 1000 records, TransferSpreadsheet to a common Excel file for reporting purposes. The queries themselves are in the external databases.
Here's the complete module:
Private Sub cmd_RunReport_Click()
Dim strProgressMessage As String
Dim DB As Database
Dim RS As Recordset
Dim strDBtoOpen As String
Dim strDatabase As String
Dim strOpenQuery As String
Dim strResults As String
Dim appAccess As Access.Application
Dim intCounter As Integer
Dim intTestEmpty As Integer
Dim strQField As String
Dim strDoNotTest As String
Dim intResponse As Integer
Set RS = CurrentDb.OpenRecordset("tbl_Qlist_Queries")
intCount = 0
strProgressMessage = ""
strResults = "{UNC to the target Excel for TransferSpreadsheet}"
strQField = "Search_NameLast"
Do While Not RS.EOF
strDBtoOpen = RS!Path & "\" & RS!File
strDatabase = RS!File
strOpenQuery = RS!Query
strDoNotTest = RS!DoNotTest
Set DB = DBEngine.OpenDatabase(strDBtoOpen)
Set appAccess = New Access.Application
If strDoNotTest = "True" Then
appAccess.OpenCurrentDatabase strDBtoOpen
appAccess.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strOpenQuery, strResults, -1
Else
appAccess.OpenCurrentDatabase strDBtoOpen
'<Right Here>
intTestEmpty = Nz(appAccess.DCount(strQField, strOpenQuery), 0)
If intTestEmpty > 0 Then
If intTestEmpty < 1000 Then
appAccess.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strOpenQuery, strResults, -1
Else
intResponse = MsgBox(Prompt:="Query " & strRunQueries & " contains " & intTestEmpty _
& " records." & vbCrLf & "Do you still want to export?", Buttons:=vbYesNo)
If intRepsonse = vbYes Then
appAccess.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strOpenQuery, strResults, -1
End If
End If
End If
End If
appAccess.CloseCurrentDatabase
Set DB = Nothing
intCounter = intCounter + 1
Me.tbx_Progress.Value = intCounter & " Query = " & strOpenQuery
Me.Repaint
RS.MoveNext
MsgBox ("Pause, CTRL+BREAK to Cancel")
Loop
End Sub
Thanks a bazillion and I bow down to you "I am not worthy."
Rob