Create pivot, use Late Binding

F

fcarboni

Registered User.
Local time
Today, 11:21
Joined
Jun 17, 2013
Messages
10
Hi,
I've a big problem to convert my VBA code for reading a qry, export to xls, create a range and with this range create a pivot table.
Not all PC on my company are Access intalled, and I need to convert all code from Early Binding to Late Binding. :banghead::banghead::banghead:
Somebody can help me??
On google I find much exsample to create a pivot table from vba, but all example are writing in Early Binding :mad:.
Someone can link me some example in L.B.
Tnk
Fabrizio
 
fcarboni said:
Hi,
I've a big problem to convert my VBA code for reading a qry, export to xls, create a range and with this range create a pivot table.
Not all PC on my company are Access intalled, and I need to convert all code from Early Binding to Late Binding. :banghead::banghead::banghead:
Somebody can help me??
On google I find much exsample to create a pivot table from vba, but all example are writing in Early Binding :mad:.
Someone can link me some example in L.B.
Tnk
Fabrizio
Click to expand...

Dim xlApp as Excel.Application ' early binding

Dim xlApp as Object
set xlApp = CreateObject("Excel.Application") ' late binding
 
fcarboni said:
Not all PC on my company are Access intalled,
Click to expand...
Is this code in Excel then? If it is in Access and they don't have Access installed, it isn't going to matter if you have early or late binding in that case because they won't be able to run anything from Access anyway.
 
SOS said:
Is this code in Excel then? If it is in Access and they don't have Access installed, it isn't going to matter if you have early or late binding in that case because they won't be able to run anything from Access anyway.
Click to expand...

This is an acceess program, all guy that Haven't access use Access Runtime.
Into access Runtime I don't have all library, and for that I need to re-write the code from E. to L. binding.

tnk
 
way2bord said:
Dim xlApp as Excel.Application ' early binding

Dim xlApp as Object
set xlApp = CreateObject("Excel.Application") ' late binding
Click to expand...
Tnk but my problem is to create the pivot table.
this is a part of my code (Early Binding)
Code: 
Sub TAB_EXP()
On Error GoTo TAB_EXP_err
Dim oRst As Object 
Set oRst = CreateObject("New ADODB.Recordset")
oRst.CursorLocation = oRst.adUseClient
oRst.Open "Select DATLAV, Order, DA, ID, CODPRP, Colli From Q_Voice_fascia_Month;", CurrentProject.Connection
Dim oApp, oWks As Object  
Set oApp = CreateObject("Excel.Application")
Set oWks = CreateObject("Excel.Workbook")
Set oWks = oApp.Workbooks.Add() 
oApp.Visible = True 
oWks.Sheets(1).Name = "Dati"
With oWks.Sheets("Dati").QueryTables.Add(oRst, oWks.ActiveSheet.Range("A1"))
    .Name = "QryEstra"
    .FieldNames = True 
    .BackgroundQuery = True 
    .RefreshStyle = oWks.xlInsertDeleteCells 
    .SaveData = True 
    .AdjustColumnWidth = True 
    .PreserveColumnInfo = True 
    .Refresh BackgroundQuery:=False 
End With
Set oRst = Nothing 
Dim oRng As Object
Set oRng = CreateObject("Excel.Range")
Set oRng = oWks.Application.Range("QryEstra")
With oWks.Sheets(2)
    .Name = "TabellaPivot"
    .Activate
End With
oWks.PivotTableWizard xlDatabase, oRng, oWks.Sheets("tabellaPivot").Cells(1, 1), "MyPivot", False, False
With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("DATLAV")
    .Orientation = oWks.xlColumnField
    .Position = 1
End With
With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("Order")
    .Orientation = oWks.xlRowField
    .Position = 1
End With
With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("DA")
    .Orientation = oWks.xlRowField
    .Position = 2
    .NumberFormat = "hh:mm:ss"
End With
With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("ID")
    .Orientation = oWks.xlRowField
    .Position = 3
    .NumberFormat = "hh:mm:ss"
End With
oWks.Sheets("tabellaPivot").PivotTables("MyPivot").AddDataField oWks.ActiveSheet.PivotTables( _
"MyPivot").PivotFields("Colli"), "TotColli", oWks.xlSum
oWks.Sheets("tabellaPivot").PivotTables("MyPivot").AddDataField oWks.ActiveSheet.PivotTables( _
"MyPivot").PivotFields("CODPRP"), "NrVoice", oWks.xlCount
    oWks.Sheets("tabellaPivot").Range("D2").Select
    With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").DataPivotField
        .Orientation = oWks.xlColumnField
        .Position = 2
    End With
oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotSelect "Order[All;Total]", _
        oWks.xlDataAndLabel, True
oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("Order").Subtotals = Array(False _
        , False, False, False, False, False, False, False, False, False, False, False)
oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotSelect "DA[All;Total]", oWks.xlDataAndLabel _
        , True
oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("DA").Subtotals = Array(False, _
        False, False, False, False, False, False, False, False, False, False, False)
Dim stDocName1 As String
Dim stDocName2 As String
Dim stDocName3 As String
Dim stDocName4 As String
Dim stDocName5 As String
stDocName1 = Format(Forms![HomePage]![Lb_DateProdAdd], "yyyy/mm/dd")
stDocName2 = "H:\Comune\Dashboard\export\ProdBGA_"
stDocName3 = MonthName(Month(stDocName1), True)
stDocName4 = "_" & Year(stDocName1)
stDocName5 = stDocName2 & stDocName3 & stDocName4
    
oWks.Author = "fcarboni"
oWks.SaveAs FileName:=stDocName5
oWks.Close True
Set oRng = Nothing
Set oWks = Nothing
Set oApp = Nothing
Exit Sub
TAB_EXP_err:
    Set oRng = Nothing
    Set oWks = Nothing
    Set oApp = Nothing
    MsgBox Err.Number & " " & Application.AccessError(Err.Number) 
End Sub
Someone can help me to re-writing in late binding, to use without library in runtime mode?
Tnk
 
So, I rewrote it for you a bit to make it a little more efficient code (you don't need things like stDocName1, 2, 3, 4 you can just use one. Also, your ADODB creation was off and you don't need to use Create Object for objects that are being created from the Excel Object. So, look what I did with the worksheet object and range object. Also, when declaring your variables you should put them all at the top so they are easy to work with. You also had one declaration where you were declaring it as a VARIANT instead of Object. This one:
Dim oApp, oWks As Object
It should be
Dim oApp As Object, oWks As Object
as it doesn't work the same in VBA as it does in VB6.

You also need to declare any Excel variables like xlDatabase because they aren't available using Late Binding.

And last of all why are you even using an ADODB recordset anyway? It isn't even used in the code anywhere (unless you omitted that part).

Code: 
Sub TAB_EXP()
    On Error GoTo TAB_EXP_err
    Dim oRst As Object
    Dim oApp As Object
    Dim oRng As Object
    Dim stDocName As String
    Dim stDateFormat As String
    Const xlDatabase As Integer = 1
 
 
    Set oRst = CreateObject("ADODB.Recordset")
 
 
    oRst.CursorLocation = oRst.adUseClient
 
 
    oRst.Open "Select DATLAV, Order, DA, ID, CODPRP, Colli From Q_Voice_fascia_Month;", CurrentProject.Connection
 
 
    oWks As Object
 
 
    Set oApp = CreateObject("Excel.Application")
 
 
    Set oWks = oApp.Workbooks.Add()
 
 
 
    oApp.Visible = True
 
 
    oWks.Sheets(1).Name = "Dati"
 
 
    With oWks.Sheets("Dati").QueryTables.Add(oRst, oWks.ActiveSheet.Range("A1"))
        .Name = "QryEstra"
        .FieldNames = True
        .BackgroundQuery = True
        .RefreshStyle = oWks.xlInsertDeleteCells
        .SaveData = True
        .AdjustColumnWidth = True
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
 
 
 
'    Set oRst = Nothing
 
 
    Set oRng = oWks.Range("QryEstra")
 
 
 
    With oWks.Sheets(2)
        .Name = "TabellaPivot"
        .Activate
    End With
 
 
 
    oWks.PivotTableWizard xlDatabase, oRng, oWks.Sheets("tabellaPivot").Cells(1, 1), "MyPivot", False, False
 
 
 
 
    With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("DATLAV")
        .Orientation = oWks.xlColumnField
        .Position = 1
    End With
 
 
 
    With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("Order")
        .Orientation = oWks.xlRowField
        .Position = 1
    End With
 
 
 
    With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("DA")
        .Orientation = oWks.xlRowField
        .Position = 2
        .NumberFormat = "hh:mm:ss"
    End With
 
 
 
    With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("ID")
        .Orientation = oWks.xlRowField
        .Position = 3
        .NumberFormat = "hh:mm:ss"
    End With
 
 
 
    oWks.Sheets("tabellaPivot").PivotTables("MyPivot").AddDataField oWks.ActiveSheet.PivotTables( _
                                                                    "MyPivot").PivotFields("Colli"), "TotColli", oWks.xlSum
 
 
    oWks.Sheets("tabellaPivot").PivotTables("MyPivot").AddDataField oWks.ActiveSheet.PivotTables( _
                                                                    "MyPivot").PivotFields("CODPRP"), "NrVoice", oWks.xlCount
 
 
    oWks.Sheets("tabellaPivot").Range("D2").Select
 
 
 
    With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").DataPivotField
        .Orientation = oWks.xlColumnField
        .Position = 2
    End With
 
 
 
    oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotSelect "Order[All;Total]", _
                                                                   oWks.xlDataAndLabel, True
 
 
    oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("Order").Subtotals = Array(False _
                                                                                      , False, False, False, False, False, False, False, False, False, False, False)
 
 
    oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotSelect "DA[All;Total]", oWks.xlDataAndLabel _
                                                                 , True
 
 
    oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("DA").Subtotals = Array(False, _
                                                                                           False, False, False, False, False, False, False, False, False, False, False)
 
 
    stDateFormat = Format(Forms![HomePage]![Lb_DateProdAdd], "yyyy/mm/dd")
 
 
    stDocName = "H:\Comune\Dashboard\export\ProdBGA_"
 
 
    stDocName = strDocName & MonthName(Month(strdateFormat), True)
 
 
    stDocName = strDocName & "_" & Year(stDateFormat)
 
 
    stDocName = stDocName2 & stDocName3 & stDocName4
 
 
    oWks.Author = "fcarboni"
 
 
    oWks.SaveAs FileName:=stDocName5
 
    oWks.Close True
 
 
    Set oRng = Nothing
 
    Set oWks = Nothing
    Set oApp = Nothing
    Exit Sub
TAB_EXP_err:
    Set oRng = Nothing
    Set oWks = Nothing
    Set oApp = Nothing
    MsgBox Err.Number & " " & Application.AccessError(Err.Number)
End Sub
 
;)
SOS said:
So, I rewrote it for you a bit to make it a little more efficient code (you don't need things like stDocName1, 2, 3, 4 you can just use one. Also, your ADODB creation was off and you don't need to use Create Object for objects that are being created from the Excel Object. So, look what I did with the worksheet object and range object. Also, when declaring your variables you should put them all at the top so they are easy to work with. You also had one declaration where you were declaring it as a VARIANT instead of Object. This one:
Dim oApp, oWks As Object
It should be
Dim oApp As Object, oWks As Object
as it doesn't work the same in VBA as it does in VB6.

You also need to declare any Excel variables like xlDatabase because they aren't available using Late Binding.

And last of all why are you even using an ADODB recordset anyway? It isn't even used in the code anywhere (unless you omitted that part).
Click to expand...
Hi SOS,
thank for your contribute,
in the RED code i received this error 438 Object doesn't support this proprierty ....
SOS said:
Code: 
Sub TAB_EXP()
    On Error GoTo TAB_EXP_err
    Dim oRst As Object
    Dim oApp As Object
    Dim oRng As Object
    Dim stDocName As String
    Dim stDateFormat As String
    Const xlDatabase As Integer = 1
    Set oRst = CreateObject("ADODB.Recordset")
    [COLOR=red][B]oRst.CursorLocation = oRst.adUseClient[/B][/COLOR]
    oRst.Open "Select DATLAV, Order, DA, ID, CODPRP, Colli From Q_Voice_fascia_Month;", CurrentProject.Connection
    oWks As Object
     Set oApp = CreateObject("Excel.Application")
    Set oWks = oApp.Workbooks.Add()
    oApp.Visible = True
    oWks.Sheets(1).Name = "Dati"
    With oWks.Sheets("Dati").QueryTables.Add(oRst, oWks.ActiveSheet.Range("A1"))
        .Name = "QryEstra"
        .FieldNames = True
        .BackgroundQuery = True
        .RefreshStyle = oWks.xlInsertDeleteCells
        .SaveData = True
        .AdjustColumnWidth = True
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
'    Set oRst = Nothing
    Set oRng = oWks.Range("QryEstra")
    With oWks.Sheets(2)
        .Name = "TabellaPivot"
        .Activate
    End With
    oWks.PivotTableWizard xlDatabase, oRng, oWks.Sheets("tabellaPivot").Cells(1, 1), "MyPivot", False, False
    With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("DATLAV")
        .Orientation = oWks.xlColumnField
        .Position = 1
    End With
    With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("Order")
        .Orientation = oWks.xlRowField
        .Position = 1
    End With
    With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("DA")
        .Orientation = oWks.xlRowField
        .Position = 2
        .NumberFormat = "hh:mm:ss"
    End With
    With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("ID")
        .Orientation = oWks.xlRowField
        .Position = 3
        .NumberFormat = "hh:mm:ss"
    End With
     oWks.Sheets("tabellaPivot").PivotTables("MyPivot").AddDataField oWks.ActiveSheet.PivotTables( _
                                                                    "MyPivot").PivotFields("Colli"), "TotColli", oWks.xlSum
 
 
    oWks.Sheets("tabellaPivot").PivotTables("MyPivot").AddDataField oWks.ActiveSheet.PivotTables( _
                                                                    "MyPivot").PivotFields("CODPRP"), "NrVoice", oWks.xlCount
 
 
    oWks.Sheets("tabellaPivot").Range("D2").Select
     With oWks.Sheets("tabellaPivot").PivotTables("MyPivot").DataPivotField
        .Orientation = oWks.xlColumnField
        .Position = 2
    End With
     oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotSelect "Order[All;Total]", _
                                                                   oWks.xlDataAndLabel, True
 
    oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("Order").Subtotals = Array(False _
                                                                                      , False, False, False, False, False, False, False, False, False, False, False)
    oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotSelect "DA[All;Total]", oWks.xlDataAndLabel _
                                                                 , True
 
    oWks.Sheets("tabellaPivot").PivotTables("MyPivot").PivotFields("DA").Subtotals = Array(False, _
                                                                                           False, False, False, False, False, False, False, False, False, False, False)
 
    stDateFormat = Format(Forms![HomePage]![Lb_DateProdAdd], "yyyy/mm/dd")
     stDocName = "H:\Comune\Dashboard\export\ProdBGA_"
 
    stDocName = [COLOR=darkorange]st[B]r[/B]DocName ;)[/COLOR] & MonthName(Month([COLOR=red]strdateFormat[/COLOR]), True)
    stDocName = [COLOR=darkorange]st[B]r[/B]DocName[/COLOR] ;)& "_" & Year([COLOR=red]stDateFormat[/COLOR])
     stDocName = [COLOR=darkorange]stDocName[B]2[/B][/COLOR] ;)& [COLOR=darkorange]stDocName[B]3[/B][/COLOR] ;) & [COLOR=darkorange]stDocName[B]4[/B] ;)[/COLOR]
     oWks.Author = "fcarboni"
    oWks.SaveAs FileName:=[COLOR=darkorange]stDocName[B]5[/B] ;)[/COLOR]
    oWks.Close True
    Set oRng = Nothing
    Set oWks = Nothing
    Set oApp = Nothing
    Exit Sub
TAB_EXP_err:
    Set oRng = Nothing
    Set oWks = Nothing
    Set oApp = Nothing
    MsgBox Err.Number & " " & Application.AccessError(Err.Number)
End Sub
Click to expand...
In thi days, I re-write this code some back, wath do you think??
Code: 
Sub PVT_EXP()
On Error GoTo ErrorHandler
Dim stdocname1 As String
Dim I As Long
stdocname1 = "Q_Voice_fascia_Month"
DoCmd.OpenQuery stdocname1, acViewPivotTable
Dim objWkb As Object
Set objWkb = CreateObject("Excel.Application")
DoCmd.RunCommand acCmdPivotTableExportToExcel
DoCmd.Close acQuery, stdocname1
   On Error Resume Next
    Dim xlApp, wbn, xlWB As Object
    Set xlApp = GetObject(, "Excel.Application")
    If xlApp Is Nothing Then
        Do Until Not xlApp Is Nothing
            Set xlApp = GetObject(, "Excel.Application")
        Loop
    Else
        wbn = xlApp.Workbooks.Count
        Do Until xlApp.Workbooks.Count <> wbn
        Loop
    End If
    Set xlWB = xlApp.ActiveWorkbook
    On Error GoTo 0
    Debug.Print xlWB.Name
With xlWB
.Sheets(1).Name = "TabellaPivot"
.Sheets(2).Name = "Dati"
End With
With xlWB.Sheets("TabellaPivot")
.PivotTables("Tabella pivot di Microsoft Office 10.0").Name = "MyPvt"
End With
With xlWB.Sheets("TabellaPivot").PivotTables("MyPvt").PivotFields("DATLAV")
    .Orientation = 2
    .Position = 1
End With
With xlWB.Sheets("TabellaPivot").PivotTables("MyPvt").PivotFields("Order")
    .Orientation = 1
    .Position = 1
End With
With xlWB.Sheets("TabellaPivot").PivotTables("MyPvt").PivotFields("DA")
    .Orientation = 1
    .Position = 2
    .NumberFormat = "hh:mm:ss"
End With
With xlWB.Sheets("TabellaPivot").PivotTables("MyPvt").PivotFields("ID")
    .Orientation = 1
    .Position = 3
    .NumberFormat = "hh:mm:ss"
End With
xlWB.Sheets("TabellaPivot").PivotTables("MyPvt").AddDataField xlWB.ActiveSheet.PivotTables( _
        "MyPvt").PivotFields("Colli"), "TotColli", -4157
xlWB.Sheets("TabellaPivot").PivotTables("MyPvt").AddDataField xlWB.ActiveSheet.PivotTables( _
        "MyPvt").PivotFields("CODPRP"), "NrVoice", -4112
xlWB.Sheets("TabellaPivot").PivotTables("MyPvt").PivotFields("Order").Subtotals = Array(False _
        , False, False, False, False, False, False, False, False, False, False, False)
xlWB.Sheets("TabellaPivot").PivotTables("MyPvt").PivotFields("DA").Subtotals = Array(False, _
        False, False, False, False, False, False, False, False, False, False, False)
xlWB.Sheets("TabellaPivot").PivotTables("MyPvt").RowGrand = False
xlWB.Sheets("TabellaPivot").PivotTables("MyPvt").ColumnGrand = False
xlWB.Sheets("TabellaPivot").Rows("1:2").Delete Shift:=-4162
For I = 1 To 3
    If (xlWB.Sheets.Count < 3) Then
        xlWB.Sheets.Add
    End If
Next
Dim stDocName2 As String
Dim stDocName3 As String
stDocName2 = Format(Forms![HomePage]![Lb_DateProdAdd], "yyyy/mm/dd")
stDocName3 = "H:\Comune\Dashboard\export\ProdBGA_"
stDocName3 = stDocName3 & MonthName(Month(stDocName2), True)
stDocName3 = stDocName3 & "_" & Year(stDocName2)
stDocName3 = stDocName3 & ".xlsx"
    
xlWB.Author = "fcarboni"
xlWB.SaveAs FileName:=stDocName3, FileFormat:=51
xlWB.Close
objWkb.Quit
ExitHandler:
    xlWB.Close
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " " & Err.Description, , "dashboard.info"
    Resume ExitHandler
End Sub
Tank,
Fabrizio
 
This:

oRst.CursorLocation = oRst.adUseClient

should be

oRst.CursorLocation = 3

If using late binding or you can set your own constant

Const adUseClient As Integer = 3

Also, again I will state - you don't even seem to be using the recordset so why open it?
 
Ciao SOS,
The debug find error on
Code: 
.RefreshStyle = oWks.xlInsertDeleteCells
same errore error 438 Object doesn't support this proprierty ....

tnk
 
You must log in or register to reply here.

Similar threads

adhoustonj
converting early binding to late binding
Replies
10
Views
1,117
Josef P.
J
zelarra821
Solved Create table by VBA in accde
2
Replies
31
Views
1,188
Pat Hartman
P
Rodeo Clown
Hello everyone, new to this forum but not to Access (or computers)
Replies
4
Views
335
The_Doc_Man
The_Doc_Man
G
  • Locked
Creating all possible Descriptions & Codes
2
Replies
22
Views
1,154
The_Doc_Man
The_Doc_Man
L
Retrieve excel from access (vol 4) , extended format , alternative color
Replies
7
Views
891
arnelgp
arnelgp

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom