excel 2003 - excel 2000 problem

**koenbuytaert** · January 3rd, 2008, 11:49 AM

Hello,

My code is working fine on my pc with windows xp home, office 2003.
I tried to install it at another laptop with windows xp home, office 2000. The program works fine, untill i want to run this piece of code :

Code:

Private Sub cmdImport_Click()
Dim intA As Integer
'Dim intB As Integer
Dim intC As Integer
Dim intD As Integer
Dim intE As Integer
'Dim intF As Integer
Dim xlApp As Excel.Application 'excel application
Dim wkBook As Excel.Workbook 'excel workbook
Dim wkSheet As Excel.Worksheet 'excel worksheet
Dim strLevering() As String
Dim liStock As ListItem

CommonDialog1.Filter = "Excel bestanden (*.xls)|*.xls|Alle bestanden|*.*"
CommonDialog1.FilterIndex = 0
CommonDialog1.ShowOpen
Caption = CommonDialog1.Filename
If CommonDialog1.Filename = "" Then Exit Sub

Set xlApp = New Excel.Application
xlApp.Workbooks.Open CommonDialog1.Filename
Set wkBook = xlApp.ActiveWorkbook
Set wkSheet = xlApp.ActiveWorkbook.Sheets(1)

ReDim strLevering(wkSheet.Cells.SpecialCells(xlCellTypeLastCell).Row - 2, 9)

For intA = 0 To wkSheet.Cells.SpecialCells(xlCellTypeLastCell).Row - 2
    strLevering(intA, 1) = wkSheet.Cells(intA + 3, 5) 'Produktnaam
    strLevering(intA, 2) = wkSheet.Cells(intA + 3, 14) 'Lotnr
    strLevering(intA, 3) = wkSheet.Cells(intA + 3, 15) 'Vervaldatum
    strLevering(intA, 4) = wkSheet.Cells(intA + 3, 13) 'Aantal
    strLevering(intA, 5) = CStr(wkSheet.Cells(intA + 3, 4)) 'Artnr
    strLevering(intA, 6) = CStr(wkSheet.Cells(intA + 3, 1)) 'Besteldatum
    strLevering(intA, 7) = CStr(wkSheet.Cells(intA + 3, 7)) 'Leveringsdatum
    strLevering(intA, 8) = CStr(wkSheet.Cells(intA + 3, 2)) 'Bestelbonnummer
    strLevering(intA, 9) = CStr(wkSheet.Cells(intA + 3, 8)) 'Leveringsbonnummer
Next intA

wkBook.Close
xlApp.Quit
Set wkSheet = Nothing
Set wkBook = Nothing
Set xlApp = Nothing

'Loopen door de geneesmiddelen die geleverd zijn en in de stock plaatsen
For intC = 0 To UBound(strLevering)
    For intE = 0 To UBound(strproduktlijst)
        If CBool(strLevering(intC, 5) = strproduktlijst(intE, 1)) Then
            If strproduktlijst(intE, 2) = vbNullString Then
                intF = MsgBox("Is " & strLevering(intC, 1) & " een kliniekverpakking?", vbYesNo Or vbInformation)
                If intF = vbYes Then
                    strproduktlijst(intE, 2) = "Ja"
                Else
                    strproduktlijst(intE, 2) = "Nee"
                End If
                Set adoRs.ActiveConnection = adoCn
                With adoRs
                .LockType = adLockOptimistic
                .CursorType = adOpenKeyset
                .Open "Select * from tblProduktlijst where ArtNr = '" & strLevering(intC, 5) & "'"
                .Fields("Kliniek") = strproduktlijst(intE, 2)
                .Update
                End With
                adoRs.Close
            End If
            
            If strproduktlijst(intE, 3) = vbNullString And strproduktlijst(intE, 2) = "Ja" Then
                strproduktlijst(intE, 3) = InputBox("Hoeveel stuks bevat " & strLevering(intC, 1) & "?")
                Set adoRs.ActiveConnection = adoCn
                With adoRs
                .LockType = adLockOptimistic
                .CursorType = adOpenKeyset
                .Open "Select * from tblProduktlijst where ArtNr = '" & strLevering(intC, 5) & "'"
                .Fields("Aantal") = strproduktlijst(intE, 3)
                .Update
                End With
                adoRs.Close
            End If
            
            For intD = 0 To strLevering(intC, 4) - 1
                Set adoRs.ActiveConnection = adoCn
                With adoRs
                .LockType = adLockOptimistic
                .CursorType = adOpenKeyset
                .Open "Select * from tblStock"
                .AddNew
                .Fields("ArtNr") = strLevering(intC, 5)
                .Fields("Produktnaam") = strLevering(intC, 1)
                .Fields("Lotnr") = strLevering(intC, 2)
                .Fields("Vervaldatum") = strLevering(intC, 3)
                .Fields("Kliniek") = strproduktlijst(intE, 2)
                If strproduktlijst(intE, 2) = "Ja" Then .Fields("Aantal") = strproduktlijst(intE, 3)
                .Fields("Besteldatum") = strLevering(intC, 6)
                .Fields("Leveringsdatum") = strLevering(intC, 7)
                .Fields("Bestelbonnummer") = strLevering(intC, 8)
                .Fields("Leveringsbonnummer") = strLevering(intC, 9)
                .Update
                End With
                adoRs.Close
            Next intD
            
            Exit For
        End If
    Next intE
Next intC

lvStock.ListItems.Clear
Set adoRs.ActiveConnection = adoCn
With adoRs
    .LockType = adLockReadOnly
    .CursorType = adOpenKeyset
    .Open "Select * from tblStock"
End With
Do While Not adoRs.EOF
    Set liStock = lvStock.ListItems.Add(, , adoRs!ArtNr & vbNullString)
    liStock.SubItems(1) = adoRs!Produktnaam & vbNullString
    liStock.SubItems(2) = adoRs!LotNr & vbNullString
    liStock.SubItems(3) = adoRs!Vervaldatum & vbNullString
    liStock.SubItems(4) = adoRs!Kliniek & vbNullString
    liStock.SubItems(5) = adoRs!Aantal & vbNullString
    'liStock.Tag = adoRs!StockId
adoRs.MoveNext
Loop
adoRs.Close


End Sub

This code adds drugs with all the needed info(wich i can download from the internet to a excel file) to my Stock table in my database (access).

I have following reference added : Microsoft Excel 11.0 Object Library.

What could be the problem?

Thanks in advance.

**dglienna** · January 3rd, 2008, 11:57 AM

Office 2000. isn't 11.0

Change your code some: This wil bind to whatever version is installed, and fail if none is installed.

Code:

Option Explicit
' These are both examples of Late Binding

Public Sub RunAccessMacro(strDB As String, strMacro As String)
'================================================================
'for late binding declare it As Object and use CreateObject() function
  Dim AccessDB As Object
  Set AccessDB = CreateObject("Access.Application")

    With AccessDB
        .OpenCurrentDatabase strDB
        .DoCmd.RunMacro strMacro, 1
        '.Visible = True    'you decide
        .CloseCurrentDatabase
    End With
    Set AccessDB = Nothing

End Sub

Public Sub ExcelMacro()
  Dim excl As Object
  Dim wrbk As Object

    Set excl = CreateObject("Excel.Application")
    excl.DisplayAlerts = False
    Set wrbk = excl.Workbooks.Open("myfile", , True, , "mypassword")
    excl.Run "MacroName", "arg1", "arg2"
End Sub

**koenbuytaert** · January 4th, 2008, 11:37 AM

Hello,

I changed my code to the this code, but now i get an error on line with [ERROR]

The error is this :

Run-time error '1004' : Property of SpecialCells of class Range can not be obtained

What could be the problem?
Thanks for help!!

Code:

Dim intA As Integer
Dim intC As Integer
Dim intD As Integer
Dim intE As Integer

Dim strLevering() As String
Dim liStock As ListItem

Dim xlApp As Object
Dim wkBook As Object
Dim wkSheet As Object

CommonDialog1.Filter = "Excel bestanden (*.xls)|*.xls|Alle bestanden|*.*"
CommonDialog1.FilterIndex = 0
CommonDialog1.ShowOpen
Caption = CommonDialog1.Filename
If CommonDialog1.Filename = "" Then Exit Sub

Set xlApp = CreateObject("Excel.Application")
Set wkBook = xlApp.Workbooks.Open(CommonDialog1.Filename)
Set wkSheet = wkBook.sheets(1)

[ERROR]ReDim strLevering(wkSheet.Cells.SpecialCells(xlCellTypeLastCell).Row - 2, 9)

For intA = 0 To wkSheet.Cells.SpecialCells(xlCellTypeLastCell).Row - 2
    strLevering(intA, 1) = wkSheet.Cells(intA + 3, 5) 'Produktnaam
    strLevering(intA, 2) = wkSheet.Cells(intA + 3, 14) 'Lotnr
    strLevering(intA, 3) = wkSheet.Cells(intA + 3, 15) 'Vervaldatum
    strLevering(intA, 4) = wkSheet.Cells(intA + 3, 13) 'Aantal
    strLevering(intA, 5) = CStr(wkSheet.Cells(intA + 3, 4)) 'Artnr
    strLevering(intA, 6) = CStr(wkSheet.Cells(intA + 3, 1)) 'Besteldatum
    strLevering(intA, 7) = CStr(wkSheet.Cells(intA + 3, 7)) 'Leveringsdatum
    strLevering(intA, 8) = CStr(wkSheet.Cells(intA + 3, 2)) 'Bestelbonnummer
    strLevering(intA, 9) = CStr(wkSheet.Cells(intA + 3, 8)) 'Leveringsbonnummer
Next intA

wkBook.Close
xlApp.Quit
Set wkSheet = Nothing
Set wkBook = Nothing
Set xlApp = Nothing

**dglienna** · January 4th, 2008, 11:48 AM

Sounds like SpecialCells of class Range didn't exist in the old version of Office. There was probably a workaround... You could also detect the version and show a message to the user.

**koenbuytaert** · January 4th, 2008, 11:55 AM

1/ Is my late-binding code OK?

2/ I used the specialcells to find to last row with data, is there another way?
I am working now on my pc with office 2003, and specialcells isn't working too.

Thanks.

**dglienna** · January 4th, 2008, 12:24 PM

Yes, it looks OK. If it opens, even better!

I would take that out of the redim statement, and try msgbox'g it. something isn't right. i think you need to set the worksheets, don't you?

**koenbuytaert** · January 4th, 2008, 12:53 PM

Code:

Set xlApp = CreateObject("Excel.Application")
Set wkBook = xlApp.Workbooks.Open(CommonDialog1.Filename)
Set wkSheet = wkBook.sheets(1)

MsgBox wkSheet.cells(1, 1).Value

I added the msgbox line, and this works.

What do you mean with

Set the worksheets

?
There is only one worksheet.

I tried to msgbox the wkSheet.Cells.SpecialCells(xlCellTypeLastCell).Row line, and get the '1004' Run-time error.

**dglienna** · January 4th, 2008, 01:13 PM

No, i meant this:

Code:

msgbox wkSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

doesn't look right

**koenbuytaert** · January 5th, 2008, 03:48 AM

What is wrong with

Code:

wkSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

?

It worked just fine when i was using early binding and the reference excel 11.0.

So, i think i must write a code that loops through te cells, to find he last row = the row where all the fields are empty.
Maybe something like :

Code:

Dim intRow as integer
Dim intLastRow as integer

intRow = 3 'In my excel file, the data starts at row 3
do until wksheet.cells(intRow, 1) = vbnullstring AND wksheet.cells(intRow, 2) = vbnullstring AND wksheet.cells(intRow, 3) = vbnullstring 
intRow = intRow +1
loop
intLastRow = intRow

**Comintern** · January 5th, 2008, 10:45 AM

If all you need to do is find the last row with data, I believe the .UsedRange property is available in Excel 2000:

Code:

MsgBox wksheet.UsedRange.Rows.Count

**dglienna** · January 5th, 2008, 11:34 AM

try ActiveCells also. I seemed to lost my link to last row or column with a sample

control-END for last cell

Edit: recorded this

Code:

   ActiveCell.SpecialCells(xlLastCell).Select

**koenbuytaert** · January 7th, 2008, 05:16 AM

Thanks dglienna and comintern for your help and time.

Code:

ActiveCell.SpecialCells(xlLastCell).Select

doesn't work.

Code:

wksheet.UsedRange.Rows.Count

does the job.
Now, i will compile it and install it on the other pc, and we will see.

Thanks

**koenbuytaert** · January 12th, 2008, 10:49 AM

This is my code, it runs with no problems on win xp and excel 2003
When i run the program on win xp and excel 2000 i got error :

Runtime error 9 : subscript out of range

Code:

Dim intA As Integer
Dim intB As Integer
Dim intC As Integer
Dim intD As Integer
Dim intE As Integer
Dim intF As Integer
Dim intLevering As Integer
Dim strLevering() As String
Dim liStock As ListItem
Dim xlApp As Object
Dim wkBook As Object
Dim wkSheet As Object

CommonDialog1.Filter = "Excel bestanden (*.xls)|*.xls|Alle bestanden|*.*"
CommonDialog1.FilterIndex = 0
CommonDialog1.ShowOpen
Caption = CommonDialog1.Filename
If CommonDialog1.Filename = "" Then Exit Sub

frmStockbeheer.MousePointer = vbHourglass
Set xlApp = CreateObject("Excel.Application")
Set wkBook = xlApp.Workbooks.Open(CommonDialog1.Filename)
Set wkSheet = wkBook.sheets(1)

intKrediet = 0
intLevering = 0
intB = 0

For intA = 0 To wkSheet.usedrange.rows.Count - 2
    If wkSheet.cells(intA + 3, 13) > 0 Then
        intLevering = intLevering + 1
    Else
        intKrediet = intKrediet + 1
    End If
Next intA

ReDim strLevering(intLevering - 1, 9)
For intA = 0 To wkSheet.usedrange.rows.Count - 2
    If wkSheet.cells(intA + 3, 13) > 0 Then
        strLevering(intB, 1) = wkSheet.cells(intA + 3, 5) 'Produktnaam
        strLevering(intB, 2) = wkSheet.cells(intA + 3, 14) 'Lotnr
        strLevering(intB, 3) = wkSheet.cells(intA + 3, 15) 'Vervaldatum
        strLevering(intB, 4) = wkSheet.cells(intA + 3, 13) 'Aantal
        strLevering(intB, 5) = CStr(wkSheet.cells(intA + 3, 4)) 'Artnr
        strLevering(intB, 6) = CStr(wkSheet.cells(intA + 3, 1)) 'Besteldatum
        strLevering(intB, 7) = CStr(wkSheet.cells(intA + 3, 7)) 'Leveringsdatum
        strLevering(intB, 8) = CStr(wkSheet.cells(intA + 3, 2)) 'Bestelbonnummer
        strLevering(intB, 9) = CStr(wkSheet.cells(intA + 3, 8)) 'Leveringsbonnummer
        intB = intB + 1
    End If
Next intA

wkBook.Close
xlApp.Quit
Set wkSheet = Nothing
Set wkBook = Nothing
Set xlApp = Nothing

'Loopen door de geneesmiddelen die geleverd zijn en in de stock plaatsen
For intC = 0 To UBound(strLevering)
    For intE = 0 To UBound(strproduktlijst)
        If CBool(strLevering(intC, 5) = strproduktlijst(intE, 1)) Then
            If strproduktlijst(intE, 2) = vbNullString Then
                intF = MsgBox("Is " & strLevering(intC, 1) & " een kliniekverpakking?", vbYesNo Or vbInformation)
                If intF = vbYes Then
                    strproduktlijst(intE, 2) = "Ja"
                Else
                    strproduktlijst(intE, 2) = "Nee"
                End If
                Set adoRs.ActiveConnection = adoCn
                With adoRs
                .LockType = adLockOptimistic
                .CursorType = adOpenKeyset
                .Open "Select * from tblProduktlijst where ArtNr = '" & strLevering(intC, 5) & "'"
                .Fields("Kliniek") = strproduktlijst(intE, 2)
                .Update
                End With
                adoRs.Close
            End If
            
            If strproduktlijst(intE, 3) = vbNullString And strproduktlijst(intE, 2) = "Ja" Then
                strproduktlijst(intE, 3) = InputBox("Hoeveel stuks bevat " & strLevering(intC, 1) & "?")
                Set adoRs.ActiveConnection = adoCn
                With adoRs
                .LockType = adLockOptimistic
                .CursorType = adOpenKeyset
                .Open "Select * from tblProduktlijst where ArtNr = '" & strLevering(intC, 5) & "'"
                .Fields("Aantal") = strproduktlijst(intE, 3)
                .Update
                End With
                adoRs.Close
            End If
            
            For intD = 0 To strLevering(intC, 4) - 1
                Set adoRs.ActiveConnection = adoCn
                With adoRs
                .LockType = adLockOptimistic
                .CursorType = adOpenKeyset
                .Open "Select * from tblStock"
                .AddNew
                .Fields("ArtNr") = strLevering(intC, 5) & vbNullString
                .Fields("Produktnaam") = strLevering(intC, 1) & vbNullString
                .Fields("Lotnr") = strLevering(intC, 2) & vbNullString
                If strLevering(intC, 3) <> vbNullString Then .Fields("Vervaldatum") = CDate(strLevering(intC, 3))
                .Fields("Kliniek") = strproduktlijst(intE, 2) & vbNullString
                If strproduktlijst(intE, 2) = "Ja" Then .Fields("Aantal") = strproduktlijst(intE, 3) & vbNullString
                .Fields("Besteldatum") = strLevering(intC, 6) & vbNullString
                .Fields("Leveringsdatum") = strLevering(intC, 7) & vbNullString
                .Fields("Bestelbonnummer") = strLevering(intC, 8) & vbNullString
                .Fields("Leveringsbonnummer") = strLevering(intC, 9) & vbNullString
                .Update
                End With
                adoRs.Close
            Next intD
            
            Exit For
        End If
    Next intE
Next intC

If intKrediet > 0 Then
strFilename = CommonDialog1.Filename
Load frmKrediet
frmKrediet.Show vbModal
End If

'lvStock updaten
lvStock.ListItems.Clear
Set adoRs.ActiveConnection = adoCn
With adoRs
    .LockType = adLockReadOnly
    .CursorType = adOpenKeyset
    .Open "Select * from tblStock"
End With
Do While Not adoRs.EOF
    Set liStock = lvStock.ListItems.Add(, , adoRs!ArtNr & vbNullString)
    liStock.SubItems(1) = adoRs!Produktnaam & vbNullString
    liStock.SubItems(2) = adoRs!LotNr & vbNullString
    liStock.SubItems(3) = adoRs!Vervaldatum & vbNullString
    liStock.SubItems(4) = adoRs!Kliniek & vbNullString
    liStock.SubItems(5) = adoRs!Aantal & vbNullString
adoRs.MoveNext
Loop
adoRs.Close
frmStockbeheer.MousePointer = vbDefault

**dglienna** · January 12th, 2008, 10:56 AM

What line is the error on?

I'm thinking 2003 allowed more cells or something.

**koenbuytaert** · January 12th, 2008, 12:42 PM

Don't know on wich line the error occurs. I get the error after installing my program on the excel 2000 pc.

I am going to uninstall office 2000 and install 2003 on that pc. That should do it.

Thread: excel 2003 - excel 2000 problem

Thread Tools

Display

excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Re: excel 2003 - excel 2000 problem

Posting Permissions