The problem is that you are referencing Access UI objects such as [Forms] within the query - that is not going to work when opening the database via an ADO connection. You need to convert those references to named parameters and then pass them from the remote process.

Your VBA code will look something like:

   ' Query database using stored procedure (requires command object)
   Set MyCommand = New ADODB.Command
   Set MyCommand.ActiveConnection = MyDatabase
   MyCommand.CommandText = "qrySomeQuery" ' <- name of procedure
   MyCommand.CommandType = adCmdStoredProc
   With MyCommand
      .Parameters.Refresh
      .Parameters.Append .CreateParameter("QueryTextParam", adVarChar, adParamInput, 10, "Value")
      .Parameters.Append .CreateParameter("QueryLongParam", adBigInt, adParamInput, , LongValue)
      .Parameters.Append .CreateParameter("QueryDateParam", adDate, adParamInput, , DateValue)
      .Parameters.Append .CreateParameter("QueryDateTimeStampParam", adDBTimeStamp, adParamInput, , DateTimeValue)
      .Parameters.Append .CreateParameter("BooleanParam", adBoolean, adParamInput, , BooleanValue)
      ' For more information about CreateParameter syntax:
      '   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/ado270/htm/mdmscadomethods.asp
      '   and navigate to CreateParameter Method
   End With

   ' Open recordset using command object
   Set MyRecordset = New ADODB.Recordset
   MyRecordset.Open MyCommand, , adOpenDynamic, adLockPessimistic
   ' For more information about Open method syntax:
   '   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/ado270/htm/mdmscadomethods.asp
   '   and navigate to Open Method (ADO Recordset)

Kevin

Do I need also to change my query?
that means instead of using parameters by form, I need to include something different?

I  meant, that something like this on my qryPivotby Partner.
I do not understand well this matter, do you have any example available

CREATE PROCEDURE pivotByParner[par1] DateTime, [par2] DateTime, [par3] Integer, [par4] Long
as SELECT QuotesFile.Theater, QuotesFile.Country, QuotesFile.[Created By User Type], ([Customer Name]) AS Customer, IIf([Created By User Name] Is Null,"EMPTY",UCase([Created By User Name])) & " - " & [Created By User Type] AS [Created by], IIf([Converted By User Name] Is Null,"EMPTY",UCase([Converted By User Name])) & " - " & [Converted By User Type] AS [Converted by], Sum(IIf(QuotesFile.[Created By Source]='CSCC' And QuotesFile.[Create Convert]=0,1,0)) AS [CSCC-Q], Sum(IIf([Created By Source]="CSCC" And QuotesFile.[Create Convert]=0,QuotesFile.[Net Price],0)) AS [CSCC-Q-V], Sum(IIf(QuotesFile.[Created By Source]='IQT' And QuotesFile.[Create Convert]=0,1,0)) AS [IQT-Q], Sum(IIf([Created By Source]="IQT" And QuotesFile.[Create Convert]=0,QuotesFile.[Net Price],0)) AS [IQT-Q-V], Sum(IIf(QuotesFile.[Created By Source]='SCC' And QuotesFile.[Create Convert]=0,1,0)) AS [SCC-Q], Sum(IIf([Created By Source]="SCC" And QuotesFile.[Create Convert]=0,QuotesFile.[Net Price],0)) AS [SCC-Q-V], Sum(IIf([Created By Source]="CSCC",1,0))/Count([ID]) AS [QAR  %], Sum(IIf(QuotesFile.[Created By Source]='CSCC' And QuotesFile.[Create Convert]=1,1,0)) AS [CSCC-O], Sum(IIf([Created By Source]="CSCC" And QuotesFile.[Create Convert]=1,QuotesFile.[Net Price],0)) AS [CSCC-O-V], Sum(IIf(QuotesFile.[Created By Source]='IQT' And QuotesFile.[Create Convert]=1,1,0)) AS [IQT-O], Sum(IIf([Created By Source]="IQT" And QuotesFile.[Create Convert]=1,QuotesFile.[Net Price],0)) AS [IQT-O-V], Sum(IIf(QuotesFile.[Created By Source]='SCC' And QuotesFile.[Create Convert]=1,1,0)) AS [SCC-O], Sum(IIf([Created By Source]="SCC" And QuotesFile.[Create Convert]=1,QuotesFile.[Net Price],0)) AS [SCC-O-V], Sum(IIf([Converted By Source]="CSCC",1,0))/Count(IIf([Converted By Source],1,0)) AS [OAR  %], QuotesFile.[Creation Date]
FROM QuotesFile
WHERE (((QuotesFile.[Creation Date]) Between [Forms]![frmDataAnalysis]![txtFOM] And [Forms]![frmDataAnalysis]![txtEOM]))
GROUP BY QuotesFile.Theater, QuotesFile.Country, QuotesFile.[Created By User Type], ([Customer Name]), IIf([Created By User Name] Is Null,"EMPTY",UCase([Created By User Name])) & " - " & [Created By User Type], IIf([Converted By User Name] Is Null,"EMPTY",UCase([Converted By User Name])) & " - " & [Converted By User Type], QuotesFile.[Creation Date], LCase([Created By User]) & " - " & [Created By User Type]
HAVING (((QuotesFile.Theater)=[Forms]![frmDataAnalysis]![cboTheater]) AND ((QuotesFile.Country)=[Forms]![frmDataAnalysis]![cboCountry]));

Select allOpen in new window

This is much easier using DAO, as you can manipulate the parameters of your queries directly. This is especially true if you refer to open forms...

The function below will open a recordset from a query, having VB evaluate the parameters, as Jet cannot see them when run from VB (the forms are only available to queries opened from the interface or from the DoCmd object).

Cheers!
(°v°)

Function OpenQuery(pstrName As String) As DAO.Recordset
 
    Dim par As DAO.Parameter
 
On Error GoTo Failure
 
    With CurrentDb.QueryDefs(pstrName)
        For Each par In .Parameters
            par.Value = Eval(par.Name)
        Next par
        Set OpenQuery = .OpenRecordset(dbOpenDynaset)
    End With
    Exit Function
    
Failure:
    MsgBox Err.Description
    Err.Clear
 
End Function

Select allOpen in new window

You need to do two things: change the Access query to accept parameters instead of pulling from form fields, and change the ADODB code to build a command that passes those parameters. I posted the sample code for the latter above. For the query, change the reference to form fields like:

   [Forms]![frmDataAnalysis]![cboTheater]

to:

   [TheaterParam]

Then, in the ADODB code, the command parameter is set up like so:

   .Parameters.Append .CreateParameter("TheaterParam", adVarChar, adParamInput, 10, "Value")

And that's it.

Kevin

I got the error run time error 3709

This the VBA Code
 
Public Sub PivotTableExportData()
 
    Dim xlapp As Excel.Application
    Dim xlwb As Excel.Workbook
    Dim xlws As Excel.Worksheet
    'Dim adors As ADODB.Recordset
    Dim MyRecordset As ADODB.Recordset
    Dim MyCommand As ADODB.Command
    Dim MyDatabase As ADODB.Connection
    
    Dim x As Long
 
    Set xlapp = New Excel.Application
    xlapp.Visible = True
    Set xlwb = xlapp.Workbooks.Add
    Set xlws = xlwb.Worksheets(1)
    xlws.Name = "RawData"
 
    'Set adors = New ADODB.Recordset
    Set MyCommand = New ADODB.Command
    Set MyCommand.ActiveConnection = MyDatabase
    MyCommand.CommandText = "qryPivotbyPartner" ' <- name of procedure
    MyCommand.CommandType = adCmdStoredProc
    With MyCommand
      .Parameters.Refresh
      .Parameters.Append .CreateParameter("TheaterParam", adVarChar, adParamInput, 10, "cboTheater")
      .Parameters.Append .CreateParameter("CountryParam", adVarChar, adParamInput, 10, "cboCountry")
      .Parameters.Append .CreateParameter("FOMParam", adDate, adParamInput, , txtFOM)
      .Parameters.Append .CreateParameter("EOMParam", adDate, adParamInput, , txtEOM)
      '.Parameters.Append .CreateParameter("QueryDateTimeStampParam", adDBTimeStamp, adParamInput, , DateTimeValue)
      '.Parameters.Append .CreateParameter("BooleanParam", adBoolean, adParamInput, , BooleanValue)
      ' For more information about CreateParameter syntax:
      '   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/ado270/htm/mdmscadomethods.asp
      '   and navigate to CreateParameter Method
   End With
 
   ' Open recordset using command object
   Set MyRecordset = New ADODB.Recordset
   MyRecordset.Open MyCommand, , adOpenDynamic, adLockPessimistic
   ' For more information about Open method syntax:
   '   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/ado270/htm/mdmscadomethods.asp
   '   and navigate to Open Method (ADO Recordset)
    
    'adors.Open "qryPivotbyPartner", CurrentProject.Connection, adOpenStatic, adLockReadOnly
 
    For x = 1 To MyRecordset.Fields.Count
    'For x = 1 To adors.Fields.Count
        'xlws.Cells(1, x) = adors.Fields(x - 1).Name
        xlws.Cells(1, x) = MyRecordset.Fields(x - 1).Name
    Next
    'xlws.Cells(2, 1).CopyFromRecordset adors
    xlws.Cells(2, 1).CopyFromRecordset MyRecordset
    'adors.Close
    MyRecordset.Close
    'Set adors = Nothing
    Set MyRecordset = Nothing
    
      
    xlwb.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=xlws.Name & "!" & _
        xlws.Cells(1, 1).CurrentRegion.Address).CreatePivotTable TableDestination:="", _
        tableName:="PivotTable2", DefaultVersion:=xlPivotTableVersion10
    xlapp.ActiveSheet.PivotTableWizard TableDestination:=xlapp.ActiveSheet.Cells(3, 1)
    xlapp.ActiveSheet.Cells(3, 1).Select
    With xlapp.ActiveSheet.PivotTables("PivotTable2")
       .AddFields RowFields:=Array("Customer", "Data"), PageFields:="Created By User Type"
       
        
        With .PivotFields("CSCC-Q")
            .Orientation = xlDataField
            .Caption = "Number CSCC-Q"
            .Position = 1
            .Function = xlCount
        End With
        With .PivotFields("CSCC-Q-V")
            .Orientation = xlDataField
            .Caption = "Total CSCC-Q-V"
            .Position = 2
            .Function = xlSum
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("IQT-Q")
            .Orientation = xlDataField
            .Caption = "Number IQT-Q"
            .Position = 3
            .Function = xlCount
        End With
        With .PivotFields("IQT-Q-V")
            .Orientation = xlDataField
            .Caption = "Total IQT-Q"
            .Position = 4
            .Function = xlSum
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("SCC-Q")
            .Orientation = xlDataField
            .Caption = "Number SCC-Q"
            .Position = 5
            .Function = xlCount
        End With
        With .PivotFields("SCC-Q-V")
            .Orientation = xlDataField
            .Caption = "Total SCC-Q-V"
            .Position = 6
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("CSCC-O")
            .Orientation = xlDataField
            .Caption = "Number CSCC-O"
            .Position = 7
            .Function = xlCount
        End With
        With .PivotFields("CSCC-O-V")
            .Orientation = xlDataField
            .Caption = "Total CSCC-O-V"
            .Position = 8
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("IQT-O")
            .Orientation = xlDataField
            .Caption = "Number IQT-O"
            .Position = 9
            .Function = xlCount
        End With
        With .PivotFields("IQT-O-V")
            .Orientation = xlDataField
            .Caption = "Total IQT-O"
            .Position = 10
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("SCC-O")
            .Orientation = xlDataField
            .Caption = "Number SCC-O"
            .Position = 11
            .Function = xlCount
        End With
        With .PivotFields("SCC-O-V")
            .Orientation = xlDataField
            .Caption = "Total SCC-O-V"
            .Position = 12
            .NumberFormat = "$#,##0.00"
        End With
        'With .PivotFields("OAR %")
        '   .Orientation = xlDataField
        '    .Caption = "% Orders-Adoption"
        '    .Position = 13
            '.NumberFormat = "$#,##0.00"
        'End With
        With .DataPivotField
            .Orientation = xlColumnField
            .Position = 1
        End With
    End With
    
    xlapp.ActiveSheet.Name = "Pivot-Data"
 
    Set xlws = Nothing
    Set xlwb = Nothing
    Set xlapp = Nothing
 
    MsgBox "Done"
 
End Sub
 
Query Code
SELECT QuotesFile.Theater, QuotesFile.Country, QuotesFile.[Created By User Type], ([Customer Name]) AS Customer, IIf([Created By User Name] Is Null,"EMPTY",UCase([Created By User Name])) & " - " & [Created By User Type] AS [Created by], IIf([Converted By User Name] Is Null,"EMPTY",UCase([Converted By User Name])) & " - " & [Converted By User Type] AS [Converted by], Sum(IIf(QuotesFile.[Created By Source]='CSCC' And QuotesFile.[Create Convert]=0,1,0)) AS [CSCC-Q], Sum(IIf([Created By Source]="CSCC" And QuotesFile.[Create Convert]=0,QuotesFile.[Net Price],0)) AS [CSCC-Q-V], Sum(IIf(QuotesFile.[Created By Source]='IQT' And QuotesFile.[Create Convert]=0,1,0)) AS [IQT-Q], Sum(IIf([Created By Source]="IQT" And QuotesFile.[Create Convert]=0,QuotesFile.[Net Price],0)) AS [IQT-Q-V], Sum(IIf(QuotesFile.[Created By Source]='SCC' And QuotesFile.[Create Convert]=0,1,0)) AS [SCC-Q], Sum(IIf([Created By Source]="SCC" And QuotesFile.[Create Convert]=0,QuotesFile.[Net Price],0)) AS [SCC-Q-V], Sum(IIf([Created By Source]="CSCC",1,0))/Count([ID]) AS [QAR  %], Sum(IIf(QuotesFile.[Created By Source]='CSCC' And QuotesFile.[Create Convert]=1,1,0)) AS [CSCC-O], Sum(IIf([Created By Source]="CSCC" And QuotesFile.[Create Convert]=1,QuotesFile.[Net Price],0)) AS [CSCC-O-V], Sum(IIf(QuotesFile.[Created By Source]='IQT' And QuotesFile.[Create Convert]=1,1,0)) AS [IQT-O], Sum(IIf([Created By Source]="IQT" And QuotesFile.[Create Convert]=1,QuotesFile.[Net Price],0)) AS [IQT-O-V], Sum(IIf(QuotesFile.[Created By Source]='SCC' And QuotesFile.[Create Convert]=1,1,0)) AS [SCC-O], Sum(IIf([Created By Source]="SCC" And QuotesFile.[Create Convert]=1,QuotesFile.[Net Price],0)) AS [SCC-O-V], Sum(IIf([Converted By Source]="CSCC",1,0))/Count(IIf([Converted By Source],1,0)) AS [OAR  %], QuotesFile.[Creation Date]
FROM QuotesFile
WHERE (((QuotesFile.[Creation Date]) Between [FOMParam] And [EOMParam]))
GROUP BY QuotesFile.Theater, QuotesFile.Country, QuotesFile.[Created By User Type], ([Customer Name]), IIf([Created By User Name] Is Null,"EMPTY",UCase([Created By User Name])) & " - " & [Created By User Type], IIf([Converted By User Name] Is Null,"EMPTY",UCase([Converted By User Name])) & " - " & [Converted By User Type], QuotesFile.[Creation Date], LCase([Created By User]) & " - " & [Created By User Type]
HAVING (((QuotesFile.Theater)=[TheaterParam]) AND ((QuotesFile.Country)=[CountryParam]));

Select allOpen in new window

Runtime-3709.JPG
debugode.JPG

Have you tried the function OpenQuery() at http:#21321093 ?

(°v°)

Where can I define my query on DAO?
I am just getting a little bit confuse
I know that I have to leave my query as I coded before :) What about using this function?

Both libraries (DAO and ADO) have recordsets, but they behave a little bit differently. It's still quite simple to switch from one to the other. In this case, the advantage of DAO is that the QueryDef object is aware of parameters, implicit or explicit, so you don't have to create them externally. But when run, it creates a DAO recordset. The potential problem is with the CopyFromRecordset method. It's supposed to work with both DAO and ADO, but I did have problems with that method and DAO.

If that doesn't work, you will have to follow the instructions other experts have given to re-create your parameters from code.

Finally, there is a third option: rewrite your entire SQL in code, replacing the criteria with constant expressions derived from your form. In the long run, that's what I use the most in this type of situations.

(°v°)

    ' Dim adors As ADODB.Recordset
    Dim daors As DAO.Recordset
    
    ' ....
    
    ' Set adors = New ADODB.Recordset
    ' adors.Open "qryPivotbyPartner", CurrentProject.Connection, adOpenStatic, adLockReadOnly
    Set daprs = OpenQuery("qryPivotbyPartner")   ' function defined above
    
    ' ...
    
    ' xlws.Cells(2, 1).CopyFromRecordset adors
    xlws.Cells(2, 1).CopyFromRecordset daors   ' <--- potential problem

Select allOpen in new window

The code looks great! Good job! The problem you have at the moment is you have not opened the connection object (opened the database). Insert the code below before the code that creates the command object. All you have to do is change the data source path to point to your Access mdb file.

   ' Open database connection
   Set MyDatabase = New ADODB.Connection
   MyDatabase.CursorLocation = adUseClient
   MyDatabase.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source='C:\full\path\to\database.mdb'; User Id=admin; Password=;"
   ' For more information about Open syntax:
   '   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/ado270/htm/mdmscadomethods.asp
   '   and navigate to Open Method (ADO Connection)
   '   Additional help constructing connection strings can be found at http://www.connectionstrings.com/

Kevin

What happens if you do not have the exact location of the DB, since i will post the file on a share folder and the final user will decide where is going to unzip the file.
Also, my application does not use user neither password, so i will leave as blank or as the way that you post.

I will try and I will let you know

thanks

Don't change the user ID and password - Access requires those settings for a normal unsecured connection.

You can ask the user for the path to the database file and then substitute it into the connection string:

   Dim FilePathName As String
   
   FilePathName = Application.GetOpenFilename("Access Database Files (*.mdb), *.mdb", Title:="Find and Open the Access Database")
   If Len(FilePathName) = 0 Then Exit Sub
   
   ' ...
   MyDatabase.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source='" & FilePathName & "'; User Id=admin; Password=;"

You might also consider asking the user for the Access database path when they first run the application and storing it somewhere so they don't have to be asked again.

Kevin

Do you have a piece of code where can I determine the currenct path of DB instead of asking the users?
Thanks

If the user can place the Access DB file anywhere, there is no way we can determine the location. You have to ask them for the path at least once.

Kevin

If there any way that I can strore the current path on a hidden text box and thex compare with it?

Public Sub PivotTableExportData()
 
    Dim xlApp As Excel.Application
    Dim xlwb As Excel.Workbook
    Dim xlws As Excel.Worksheet
    'Dim adors As ADODB.Recordset
    Dim MyRecordset As ADODB.Recordset
    Dim MyCommand As ADODB.Command
    Dim MyDatabase As ADODB.Connection
    
    Dim x As Long
 
    Set xlApp = New Excel.Application
    xlApp.Visible = True
    Set xlwb = xlApp.Workbooks.Add
    Set xlws = xlwb.Worksheets(1)
    xlws.Name = "RawData"
 
    'Set adors = New ADODB.Recordset
    Set MyDatabase = New ADODB.Connection
    MyDatabase.CursorLocation = adUseClient
    MyDatabase.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source='C:\Documents and Settings\giofranc\My Documents\My Projects\FY08-02\CSCC Adoption Metrics Tool\CSCC-AMT-3292008.mdb'; User Id=admin; Password=;"
 
    'Set MyCommand = New ADODB.Command
    Set MyCommand = New ADODB.Connection
    Set MyCommand.ActiveConnection = MyDatabase
    MyCommand.CommandText = "ADOqryPivotbyPartner" ' <- name of procedure
    MyCommand.CommandType = adCmdStoredProc
    With MyCommand
      .Parameters.Refresh
      .Parameters.Append .CreateParameter("TheaterParam", adVarChar, adParamInput, 10, "cboTheater")
      .Parameters.Append .CreateParameter("CountryParam", adVarChar, adParamInput, 10, "cboCountry")
      .Parameters.Append .CreateParameter("FOMParam", adDate, adParamInput, , txtFOM)
      .Parameters.Append .CreateParameter("EOMParam", adDate, adParamInput, , txtEOM)
      '.Parameters.Append .CreateParameter("QueryDateTimeStampParam", adDBTimeStamp, adParamInput, , DateTimeValue)
      '.Parameters.Append .CreateParameter("BooleanParam", adBoolean, adParamInput, , BooleanValue)
      ' For more information about CreateParameter syntax:
      '   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/ado270/htm/mdmscadomethods.asp
      '   and navigate to CreateParameter Method
   End With
 
   ' Open recordset using command object
   Set MyRecordset = New ADODB.Recordset
   MyRecordset.Open MyCommand, , adOpenDynamic, adLockPessimistic
   ' For more information about Open method syntax:
   '   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/ado270/htm/mdmscadomethods.asp
   '   and navigate to Open Method (ADO Recordset)
    
    'adors.Open "qryPivotbyPartner", CurrentProject.Connection, adOpenStatic, adLockReadOnly
 
    For x = 1 To MyRecordset.Fields.Count
    'For x = 1 To adors.Fields.Count
        'xlws.Cells(1, x) = adors.Fields(x - 1).Name
        xlws.Cells(1, x) = MyRecordset.Fields(x - 1).Name
    Next
    'xlws.Cells(2, 1).CopyFromRecordset adors
    xlws.Cells(2, 1).CopyFromRecordset MyRecordset
    'adors.Close
    MyRecordset.Close
    'Set adors = Nothing
    Set MyRecordset = Nothing
    
      
    xlwb.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=xlws.Name & "!" & _
        xlws.Cells(1, 1).CurrentRegion.Address).CreatePivotTable TableDestination:="", _
        tableName:="PivotTable2", DefaultVersion:=xlPivotTableVersion10
    xlApp.ActiveSheet.PivotTableWizard TableDestination:=xlApp.ActiveSheet.Cells(3, 1)
    xlApp.ActiveSheet.Cells(3, 1).Select
    With xlApp.ActiveSheet.PivotTables("PivotTable2")
       .AddFields RowFields:=Array("Customer", "Data"), PageFields:="Created By User Type"
       
        
        With .PivotFields("CSCC-Q")
            .Orientation = xlDataField
            .Caption = "Number CSCC-Q"
            .Position = 1
            .Function = xlCount
        End With
        With .PivotFields("CSCC-Q-V")
            .Orientation = xlDataField
            .Caption = "Total CSCC-Q-V"
            .Position = 2
            .Function = xlSum
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("IQT-Q")
            .Orientation = xlDataField
            .Caption = "Number IQT-Q"
            .Position = 3
            .Function = xlCount
        End With
        With .PivotFields("IQT-Q-V")
            .Orientation = xlDataField
            .Caption = "Total IQT-Q"
            .Position = 4
            .Function = xlSum
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("SCC-Q")
            .Orientation = xlDataField
            .Caption = "Number SCC-Q"
            .Position = 5
            .Function = xlCount
        End With
        With .PivotFields("SCC-Q-V")
            .Orientation = xlDataField
            .Caption = "Total SCC-Q-V"
            .Position = 6
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("CSCC-O")
            .Orientation = xlDataField
            .Caption = "Number CSCC-O"
            .Position = 7
            .Function = xlCount
        End With
        With .PivotFields("CSCC-O-V")
            .Orientation = xlDataField
            .Caption = "Total CSCC-O-V"
            .Position = 8
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("IQT-O")
            .Orientation = xlDataField
            .Caption = "Number IQT-O"
            .Position = 9
            .Function = xlCount
        End With
        With .PivotFields("IQT-O-V")
            .Orientation = xlDataField
            .Caption = "Total IQT-O"
            .Position = 10
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("SCC-O")
            .Orientation = xlDataField
            .Caption = "Number SCC-O"
            .Position = 11
            .Function = xlCount
        End With
        With .PivotFields("SCC-O-V")
            .Orientation = xlDataField
            .Caption = "Total SCC-O-V"
            .Position = 12
            .NumberFormat = "$#,##0.00"
        End With
        'With .PivotFields("OAR %")
        '   .Orientation = xlDataField
        '    .Caption = "% Orders-Adoption"
        '    .Position = 13
            '.NumberFormat = "$#,##0.00"
        'End With
        With .DataPivotField
            .Orientation = xlColumnField
            .Position = 1
        End With
    End With
    
    xlApp.ActiveSheet.Name = "Pivot-Data"
 
    Set xlws = Nothing
    Set xlwb = Nothing
    Set xlApp = Nothing
 
    MsgBox "Done"
 
End Sub

Select allOpen in new window

debugmodetypmismatch.JPG
Type-mismatch.JPG

I would use a named constant. Named constants are saved with the workbook and accessible from anywhere in the VBA project.

   Dim FilePathName As String
   
   FilePathName = Application.GetOpenFilename("Access Database Files (*.mdb), *.mdb", Title:="Find and Open the Access Database")
   If Len(FilePathName) = 0 Then Exit Sub
   ThisWorkbook.Names.Add "MyAccessDBPath", FilePathName
   
   ' ...
   MyDatabase.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source='" & [MyAccessDBPath] & "'; User Id=admin; Password=;"

Kevin

why do i got this error?

Harfanq,

I tested yours too but it is not working, could u able to look up it.

Public Sub PivotTableExportData()
 
    Dim xlApp As Excel.Application
    Dim xlwb As Excel.Workbook
    Dim xlws As Excel.Worksheet
    Dim daors As DAO.Recordset
    Dim x As Long
 
    Set xlApp = New Excel.Application
    xlApp.Visible = True
    Set xlwb = xlApp.Workbooks.Add
    Set xlws = xlwb.Worksheets(1)
    xlws.Name = "RawData"
 
    Set daprs = OpenQuery("qryPivotbyPartner")   ' function defined above
    
    xlws.Cells(2, 1).CopyFromRecordset daors   ' <--- potential problem
 
      
    xlwb.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=xlws.Name & "!" & _
        xlws.Cells(1, 1).CurrentRegion.Address).CreatePivotTable TableDestination:="", _
        tableName:="PivotTable2", DefaultVersion:=xlPivotTableVersion10
    xlApp.ActiveSheet.PivotTableWizard TableDestination:=xlApp.ActiveSheet.Cells(3, 1)
    xlApp.ActiveSheet.Cells(3, 1).Select
    With xlApp.ActiveSheet.PivotTables("PivotTable2")
       .AddFields RowFields:=Array("Customer", "Data"), PageFields:="Created By User Type"
       
        
        With .PivotFields("CSCC-Q")
            .Orientation = xlDataField
            .Caption = "Number CSCC-Q"
            .Position = 1
            .Function = xlCount
        End With
        With .PivotFields("CSCC-Q-V")
            .Orientation = xlDataField
            .Caption = "Total CSCC-Q-V"
            .Position = 2
            .Function = xlSum
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("IQT-Q")
            .Orientation = xlDataField
            .Caption = "Number IQT-Q"
            .Position = 3
            .Function = xlCount
        End With
        With .PivotFields("IQT-Q-V")
            .Orientation = xlDataField
            .Caption = "Total IQT-Q"
            .Position = 4
            .Function = xlSum
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("SCC-Q")
            .Orientation = xlDataField
            .Caption = "Number SCC-Q"
            .Position = 5
            .Function = xlCount
        End With
        With .PivotFields("SCC-Q-V")
            .Orientation = xlDataField
            .Caption = "Total SCC-Q-V"
            .Position = 6
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("CSCC-O")
            .Orientation = xlDataField
            .Caption = "Number CSCC-O"
            .Position = 7
            .Function = xlCount
        End With
        With .PivotFields("CSCC-O-V")
            .Orientation = xlDataField
            .Caption = "Total CSCC-O-V"
            .Position = 8
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("IQT-O")
            .Orientation = xlDataField
            .Caption = "Number IQT-O"
            .Position = 9
            .Function = xlCount
        End With
        With .PivotFields("IQT-O-V")
            .Orientation = xlDataField
            .Caption = "Total IQT-O"
            .Position = 10
            .NumberFormat = "$#,##0.00"
        End With
        With .PivotFields("SCC-O")
            .Orientation = xlDataField
            .Caption = "Number SCC-O"
            .Position = 11
            .Function = xlCount
        End With
        With .PivotFields("SCC-O-V")
            .Orientation = xlDataField
            .Caption = "Total SCC-O-V"
            .Position = 12
            .NumberFormat = "$#,##0.00"
        End With
        'With .PivotFields("OAR %")
        '   .Orientation = xlDataField
        '    .Caption = "% Orders-Adoption"
        '    .Position = 13
            '.NumberFormat = "$#,##0.00"
        'End With
        With .DataPivotField
            .Orientation = xlColumnField
            .Position = 1
        End With
    End With
    
    xlApp.ActiveSheet.Name = "Pivot-Data"
 
    Set xlws = Nothing
    Set xlwb = Nothing
    Set xlApp = Nothing
 
    MsgBox "Done"
 
End Sub

Select allOpen in new window

DAO-Error-function-not-defined.JPG

You're getting a type mismatch because my code was changed. This:

    'Set MyCommand = New ADODB.Command
    Set MyCommand = New ADODB.Connection

should be:

    Set MyCommand = New ADODB.Command

Kevin

Note: Although I use DAO a lot, there are clearly advantages in using ADO. If you have extensive data, you are probably better off with zorvek's suggestion. (Especially now that you went though the motions anyway!)

(°v°)

Also, DAO is no longer supported by Microsoft - it's deprecated in favor of ADO and newer technologies.

Kevin

So, how will  be the final solution?
Anyone could assist me on better way?

How will be looks like using these parameters from the form
txtFOM mm/dd/yyyy
txtEOM mm/dd/yyyy
cboTheater
cboCountry
from my form since my SQL Is huge
I am really appreciate much help, thanks

Thanks

Function DateSQL(pvarFOM, pvarEOM, Theater, Country) As String
    If IsNull(pvarDate) Then
        DateSQL = "Null"
    Else
        DateSQLFOM = "#" & Format(pvarFOM, "yyyy-mm-dd") & "#"
        DateSQLEOM = "#" & Format(pvarEOM, "mm/dd/yyyy") & "#"
        SQLTheater = Me.cboTheater
        SQLCountry = Me.Country
 
    End If
End Function
 
....
 
    Dim strSQL As String
 
    With Forms!frmDataAnalysis
        strSQL _
            = " SELECT * FROM QuotesFile" _
            & " WHERE [Creation Date])" _
            & "  Between " & DateSQL(!txtFOM) _
            & "  And " & DateSQL(!txtEOM)
    End With
 
    ' use query...
 

Select allOpen in new window

The first function should not be modified. Is simply takes a date and converts it to a string, in a format suitable for SQL. Like this (from the immediate pane):

    ? DateSQL(Date())
    #2008-04-15#

or, in your case and if the form is open:

    ? DateSQL(Forms!frmDataAnalysis!txtFOM)
    #2000-01-01#   ' or whatever is current

The fragment below the function is meant as an illustration on how to build queries from scratch in code, if you wanted to try that. Observe how the function is used to build the string using the dates from your form.

But seeing how you modified the function, I don't think you should go this way just yet. Gather a little more experience in programming, because it really quite tricky to write code for one language (SQL) from another (VB).

Revert back to one of the previous solutions.

(°v°)

For ADO?

Could you able to look up it this link it is related, thanks
https://www.experts-exchange.com/questions/23313405/Exporting-query-to-and-Excel-Template.html

It seems you are getting ample help already. Just one advice: you are posting way too many full screen shots. It's often simpler to copy the error message, or at the very least cut down your images to the minimum. The way you do it, it's simply too painful to read through the entire thread, open every image (they are unreadable), filter out the irrelevant visuals, etc. At least, you don't wrap your images in word documents, as so many Askers seem to do...

Good luck!
(°v°)

Thank you, are you able to give some help based on my requirements, i am eager to learn, since i am consider novice on programming.
Thanks

Deletion? Seems a little harsh considering all the work Harfang and I put into this effort.

This post will cancel the pending deletion request.

Kevin

First, let's see what gfranco has to say about the matter. Second, he did post a question to which neither Harfang nor I responded. Since the Harfang was the last Expert to post I'll put the onus on him to respond. Third, this question got a little more involved than most questions do and I would like to see if gfranco can simplify/articulate what the exact problem is at this point. His last comment "are you able to give some help based on my requirements, i am eager to learn, since i am consider novice on programming" implies that this is an open ended question that will be difficult to resolve. If we return to the original question, an error, then the first few posts by Harfang and I appear to resolve the issue.

The bottom line is gfranco needs to explain what the current situation is. If he has resolved the issue then I would like to see that resolution posted. If that resolution is based on solutions that Harfang and/or I provided than credit should be provided.

Kevin

Hi,

The last contribuitor post said: that i need little bit more knowledge on programming. I know that i am not an expert, and i was trying to look something good that might fit to my requiriment.
I will give you a bonus, for me is not a problem, but i thought that i would be more supported.

Thanks anyway for your time :)