Changing to late binding

J

jasn_78

Registered User.
Local time
Tomorrow, 07:37
Joined
Aug 1, 2001
Messages
214
Hey every1 sorry bout this but cant seem to figure out how to do this atm.

I have the below code referenced to Excel 12.0 reference and as different customer have different version of Excel I think it would be a good idea to change to latebinding.

Does any1 know any easy way of changing my code from early to late binding.


Cheers
Jason

Code: 
Public gobjexcel As excel.Application



Public Function excelquery(strsql As String)

Dim rstdata As ADODB.Recordset
Dim rstcount As ADODB.Recordset
Dim fld As ADODB.field
Dim rng As excel.Range
Dim objws As excel.worksheet
Dim introwcount As Integer
Dim intcolcount As Integer
Dim qcount As Integer

DoCmd.Hourglass True

Set rstdata = New ADODB.Recordset
rstdata.ActiveConnection = CurrentProject.Connection

Set rstcount = New ADODB.Recordset
rstcount.ActiveConnection = CurrentProject.Connection

If CreateRecordset(rstdata, rstcount, strsql) Then


    If CreateExcelObj() Then
        gobjexcel.Workbooks.Add
        gobjexcel.Application.DisplayAlerts = False
        
        Set objws = gobjexcel.ActiveSheet
        introwcount = 1
        intcolcount = 1
        
        For Each fld In rstdata.Fields
            If fld.Type <> adLongVarBinary Then
                objws.Cells(1, intcolcount).VALUE = fld.Name
                intcolcount = intcolcount + 1
            End If
        Next fld
        
        objws.Range("A2").CopyFromRecordset rstdata, 500
        
        With gobjexcel
            .Columns("A:C").Select
            .Columns("A:C").EntireColumn.AutoFit
            .Range("A1").Select
            .ActiveCell.CurrentRegion.Select
            Set rng = .Selection
            .Columns("b:c").Select
            .Selection.NumberFormat = "$#,##0.00"
            .Rows("1:1").Select
            .Selection.Font.Bold = True
            With .Selection
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlBottom
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = False
            End With
        
            .Sheets("sheet1").Select
            .Sheets("sheet1").Name = "SALES FIGURES"
            
            .Sheets("sheet2").Select
            .Sheets("sheet2").Name = "COMPARISON GRAPH"
            
            .ActiveSheet.ChartObjects.Add(0, 0, 607.75, 301).Select
            
            .ActiveChart.ChartWizard Source:=.Sheets("SALES FIGURES").Range(rng.address), _
                gallery:=xlColumn, _
                Format:=6, PlotBy:=xlColumns, categorylabels:=1, serieslabels _
                :=1, HasLegend:=1, Title:="SALES COMPARISON REPORT", categorytitle _
                :="DAYS", valuetitle:="$ AMOUNT", extratitle:=""
            .Visible = True

            '    .Range("A22").Select
            '    .ActiveCell.FormulaR1C1 = "PERIOD 1 ="
            '    .Range("A23").Select
            '    .ActiveCell.FormulaR1C1 = "PERIOD 2 ="
            '    .Range("A24").Select
            '    .ActiveCell.FormulaR1C1 = "PERIOD 3 ="
            '    .Range("A25").Select
            '    .ActiveCell.FormulaR1C1 = "PERIOD 4 ="
                
                .Sheets("Sheet3").Select
                .ActiveWindow.SelectedSheets.Delete

        End With
        Else
        MsgBox "Excel Could not load"
        
    End If
    Else
    MsgBox "too many records to send"
    
End If
    
DoCmd.Hourglass False

Set rng = Nothing
Set objws = Nothing
Set gobjexcel = Nothing

End Function

Function CreateRecordset(rstdata As ADODB.Recordset, _
    rstcount As ADODB.Recordset, _
    strsql As String)
    Dim rst As ADODB.Recordset
    
'    On Error GoTo CreateRecordset_Err
    'Create recordset that contains count of records in query
    rstcount.Open strsql
    
    'rstcount.Open "Select Count(*) As NumRecords from " & strTableName
    'If more than 500 records in query result, return false
    'Otherwise, create recordset from query
    If rstcount.RecordCount > 500 Then
        CreateRecordset = False
    Else
        rstdata.Open strsql
        CreateRecordset = True
    End If
    
CreateRecordset_Exit:
    Set rstcount = Nothing
    Exit Function
    
CreateRecordset_Err:
    MsgBox "Error # " & Err.Number & ": " & Err.DESCRIPTION, , "RECORDSET ERROR"
    Resume CreateRecordset_Exit
End Function

Function CreateExcelObj() As Boolean
'    On Error GoTo CreateExcelObj_Err
    CreateExcelObj = False
    'Attempt to Launch Excel
    Set gobjexcel = New excel.Application
    CreateExcelObj = True
    
CreateExcelObj_Exit:
    Exit Function
    
CreateExcelObj_Err:
    MsgBox "Couldn't Launch Excel!!", vbCritical, "Warning!!"
    CreateExcelObj = False
    Resume CreateExcelObj_Exit
End Function

Sub CloseExcel()
    
    If Not gobjexcel Is Nothing Then
        gobjexcel.DisplayAlerts = False
        gobjexcel.Quit
    End If
    
CloseExcel_Exit:
    Set gobjexcel = Nothing
    Exit Sub
    
CloseExcel_Err:
    MsgBox "Error # " & Err.Number & ": " & Err.DESCRIPTION
    Resume CloseExcel_Exit
End Sub
 
ok guys I have figured that out :)

only problem is when i install the packaged software on a client's pc i am getting the following error

error -2147467259: odbc--call failed

i know it is in the following code due to my error messages but I can't figure out what would be getting this error :(

Code: 
Public Function excelquery(strsql As String)

On Error GoTo excel_error

Dim gobjExcel As Object
Dim objws As Object
Dim rng As Object


Set gobjExcel = CreateObject("Excel.Application")

Dim rstdata As ADODB.Recordset
Dim rstcount As ADODB.Recordset
Dim fld As ADODB.field
Dim introwcount As Integer
Dim intcolcount As Integer
Dim qcount As Integer



DoCmd.Hourglass True

Set rstdata = New ADODB.Recordset
rstdata.ActiveConnection = CurrentProject.Connection

Set rstcount = New ADODB.Recordset
rstcount.ActiveConnection = CurrentProject.Connection

If CreateRecordset(rstdata, rstcount, strsql) Then

    If CreateExcelObj() Then
    With gobjExcel
        .Workbooks.Add
        .Application.DisplayAlerts = False
        
        Set objws = .ActiveSheet
        introwcount = 1
        intcolcount = 1
        
        For Each fld In rstdata.Fields
            If fld.Type <> adLongVarBinary Then
                objws.Cells(1, intcolcount).VALUE = fld.Name
                intcolcount = intcolcount + 1
            End If
        Next fld
        
        objws.range("A2").CopyFromRecordset rstdata, 500
        
            .Columns("A:C").Select
            .Columns("A:C").EntireColumn.AutoFit
            .range("A1").Select
            .ActiveCell.CurrentRegion.Select
            Set rng = .Selection
            .Columns("b:c").Select
            .Selection.NumberFormat = "$#,##0.00"
            .Rows("1:1").Select
            .Selection.Font.Bold = True
            With .Selection
                    .HorizontalAlignment = -4108
                    .VerticalAlignment = -4107
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = 1
                    .MergeCells = False
            End With
    'With gobjExcel
    
            .Sheets("sheet1").Select
            .Sheets("sheet1").Name = "SALES FIGURES"
            
            .Sheets("sheet2").Select
            .Sheets("sheet2").Name = "COMPARISON GRAPH"
            
            .ActiveSheet.ChartObjects.Add(0, 0, 607.75, 301).Select
            
            .ActiveChart.ChartWizard Source:=.Sheets("SALES FIGURES").range(rng.address), _
                gallery:=3, _
                Format:=6, PlotBy:=2, categorylabels:=1, serieslabels _
                :=1, HasLegend:=1, Title:="SALES COMPARISON REPORT", categorytitle _
                :="DAYS", valuetitle:="$ AMOUNT", extratitle:=""
            .Visible = True
              
            .Sheets("Sheet3").Select
            .ActiveWindow.SelectedSheets.Delete

    End With
        Else
        MsgBox "Excel Could not load"
        
    End If
    Else
    MsgBox "too many records to send"
    
End If
    
DoCmd.Hourglass False

Set rng = Nothing
Set objws = Nothing
Set gobjExcel = Nothing

excel_exit:
    Exit Function

excel_error:
    MsgBox "Error " & Err.Number & ": " & Err.DESCRIPTION, , "EXCEL ERROR"
    Resume excel_exit

End Function

thanks
Jason
 
Jason,

To tell you the truth, I didn't read all that code.

What line throws the error?

If you change it to Early binding, you will explicitly declare your Excel object
as 9.0 or 10.0, or whatever.

The early binding will give you the "Intellisense", but the late binding will let
you work with "anything".

I am in no way well-versed in Excel, but since you didn't share what line
threw the error ...

Just some thoughts,
Wayne
 
Wayne I have narrowed it down to
Code: 
Function CreateRecordset(rstdata As ADODB.Recordset, _
    rstcount As ADODB.Recordset, _
    strsql As String)
    Dim rst As ADODB.Recordset
    
'    On Error GoTo CreateRecordset_Err
    'Create recordset that contains count of records in query
    rstcount.Open strsql
    
    'rstcount.Open "Select Count(*) As NumRecords from " & strTableName
    'If more than 500 records in query result, return false
    'Otherwise, create recordset from query
    If rstcount.RecordCount > 500 Then
        CreateRecordset = False
    Else
        rstdata.Open strsql
        CreateRecordset = True
    End If

The reason I am not using early binding is various customers have various version of Excel

What i am however doing is creating the code with early binding then changing it to late binding.
 
Jason,

Your function doesn't return a value!

Public Function CreateRecordset() As Boolean

Also, why not just use the DCount function?

If DCount("[*]", strTableName) > 500 Then ...

Need more info ...

Wayne
 
Wayne to be honest grabbed the code out of a text book I have been reading still learning most of this stuff so just followed the example and then edited it.

Any better ideas would be appreciated.
 
You need to further limit down to the row that is raising the issue.
One of your recordset Open statements would be to blame.
Test the SQL statement used to open the recordset. Since you're using the CurrentProject connection but get an ODBC error I'll guess that you have linked tables to a server DB source? Try the query stand alone. If it works - post the problem SQL here.

Also worth mentioning is the earlier assignment of the connection to the recorsdets.
rstdata.ActiveConnection = CurrentProject.Connection
should be
Set rstdata.ActiveConnection = CurrentProject.Connection

Finally - your function was returning a value (all functions do).
But as it was unspeicifed it was returning a variant.
You were assigning boolean results to that variant value.
Declaring the return type is more efficient (variants are memory hungry), better practice and will give you intellisense support when coding against that function call.
 
Leigh, what I dont get is how come it works perfectly everytime I run it on my computer but when I test it on a clients I have problems, I have now tested it with the SET command put it in and now what happens if i try one period to graph on it works but displays data from days before my start date. However I then try on my p.c and it works :( talk about confusing

lol
 
The problem line is this

rstcount.Open strsql

Well i am thinking it is this based on the following code and the fact i get a an error saying RECORDSET ERROR1 and this is the only line of code that is running before my other error codes come into play.



Code: 
Function CreateRecordset(rstdata As ADODB.Recordset, _
    rstcount As ADODB.Recordset, _
    strsql As String)
    Dim rst As ADODB.Recordset
    
On Error GoTo CreateRecordset_Err1
    'Create recordset that contains count of records in query
    rstcount.Open strsql
    
    'rstcount.Open "Select Count(*) As NumRecords from " & strTableName
    'If more than 500 records in query result, return false
    'Otherwise, create recordset from query
On Error GoTo CreateRecordset_Err2
    If rstcount.RecordCount > 500 Then
        CreateRecordset = False
    Else
On Error GoTo CreateRecordset_Err3
        rstdata.Open strsql
        CreateRecordset = True
    End If
    
CreateRecordset_Exit:
    Set rstcount = Nothing
    Exit Function
    
CreateRecordset_Err1:
    MsgBox "Error # " & Err.Number & ": " & Err.DESCRIPTION, , "RECORDSET ERROR1"
    Resume CreateRecordset_Exit

CreateRecordset_Err2:
    MsgBox "Error # " & Err.Number & ": " & Err.DESCRIPTION, , "RECORDSET ERROR2"
    Resume CreateRecordset_Exit

CreateRecordset_Err3:
    MsgBox "Error # " & Err.Number & ": " & Err.DESCRIPTION, , "RECORDSET ERROR3"
    Resume CreateRecordset_Exit
End Function
 
And here is the strsql line

SELECT QRYCOMPARISON1.DAY, QRYCOMPARISON2.PERIOD2 FROM QRYCOMPARISON1, QRYCOMPARISON2
WHERE QRYCOMPARISON1.DAY = QRYCOMPARISON2.DAY
 
Ok the code is now as follows

Code: 
Function CreateRecordset(rstdata As ADODB.Recordset, _
    rstcount As ADODB.Recordset, _
    strsql As String) As Boolean

Dim rst As ADODB.Recordset
Dim count As Integer
    
    On Error GoTo CreateRecordset_Err1
    'Create recordset that contains count of records in query
 
    count = DCount("Day", "qryCOMPARISON1")
    MsgBox count
         
    'rstcount.Open "Select Count(*) As NumRecords from " & strTableName
    'If more than 500 records in query result, return false
    'Otherwise, create recordset from query
    On Error GoTo CreateRecordset_Err2
    If count > 500 Then
        CreateRecordset = False
    Else
    On Error GoTo CreateRecordset_Err3
        rstdata.Open strsql
        CreateRecordset = True
    End If
    
CreateRecordset_Exit:
    Set rstcount = Nothing
    Exit Function
    
CreateRecordset_Err1:
    MsgBox "Error # " & Err.Number & ": " & Err.DESCRIPTION, , "RECORDSET ERROR1"
    Resume CreateRecordset_Exit

CreateRecordset_Err2:
    MsgBox "Error # " & Err.Number & ": " & Err.DESCRIPTION, , "RECORDSET ERROR2"
    Resume CreateRecordset_Exit

CreateRecordset_Err3:
    MsgBox "Error # " & Err.Number & ": " & Err.DESCRIPTION, , "RECORDSET ERROR3"
    Resume CreateRecordset_Exit
End Function

and i get the attached screen shot as my error message
 

Attachments

  • RECORDSET ERROR.jpg
    RECORDSET ERROR.jpg
    11.4 KB · Views: 127
Jason,

"it works perfectly everytime I run it on my computer "

I'd think that your "non-functional" computer has U.S. date settings.

Dates are stored universally.

Being in the U.S. I don't deal with this, but you can probably search here
for "date Format" or "UK dates".

hth,
Wayne
 
Thanks Wayne but pc is in Australia settings which includes dd/mm/yy

the one thing that i am thinking is that I know firebird stores dates as mm/dd/yyyy but i can see how it would be working here and not on the customers

:(
 
Wayne, yeah so I dont get what is wrong

Grrrrr geez I hate when something works in one place and not somewhere else.
 
ok and now to top it off i have tried it on a second customers site. working fine the only difference is the first site is windows 2003 server the second is xp pro
 
You must log in or register to reply here.

Similar threads

Gasman
Solved Open Excel workbook, but have WorkBook_Open code run
Replies
19
Views
535
Gasman
Gasman
adhoustonj
converting early binding to late binding
Replies
10
Views
1,245
Josef P.
J
zelarra821
Solved Protect VBA Project Programmatically with SendKeys
Replies
12
Views
831
zelarra821
zelarra821
R
  • Question Question
Using vba to select a particular record in a combo box is not working properly
Replies
4
Views
507
cheekybuddha
cheekybuddha
A
how to insert attachment in sharepoint list using ado access vba
Replies
3
Views
787
theDBguy
theDBguy

Users who are viewing this thread

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