excel 2003 - excel 2000 problem
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.
Re: excel 2003 - excel 2000 problem
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
Re: excel 2003 - excel 2000 problem
Hello,
I changed my code to the this code, but now i get an error on line with [ERROR]
The error is this :
Quote:
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
Re: excel 2003 - excel 2000 problem
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.
Re: excel 2003 - excel 2000 problem
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.
Re: excel 2003 - excel 2000 problem
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?
Re: excel 2003 - excel 2000 problem
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
Quote:
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.
Re: excel 2003 - excel 2000 problem
No, i meant this:
Code:
msgbox wkSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
doesn't look right
Re: excel 2003 - excel 2000 problem
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
Re: excel 2003 - excel 2000 problem
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
Re: excel 2003 - excel 2000 problem
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
Re: excel 2003 - excel 2000 problem
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
Re: excel 2003 - excel 2000 problem
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 :
Quote:
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
Re: excel 2003 - excel 2000 problem
What line is the error on?
I'm thinking 2003 allowed more cells or something.
Re: excel 2003 - excel 2000 problem
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.
