Excel template (xlsx) or file (xls)

[pvl]

Hi,

I have an old VB6 code, which doesn't work.

im myXL As Object
Dim myXLSheet As Object
Dim ExcelWasNotRunning As Boolean
Dim FileNum As Integer, RecLength As Long, Kern_0ducts As Kern_data_ducts
Dim i As Integer
On Error Resume Next
Set myXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear
Call DetectExcel
Set myXL = GetObject("e:\Kerndata_new\DCC_TABLES.xls")
'sheet nrs veranderen 1,2,3,4,..
Set myXLSheet = myXL.worksheets(3)
myXL.application.Visible = True
myXL.Parent.windows(1).Visible = True
'
RecLength = Len(Kern_0ducts)
' Get the next available file number.
FileNum = FreeFile
' Open the new file with the Open statement.
'Kern_XXXducts=Kern_03ducts of Kern_1ducts of Kern_2ducts
'of Kern_3ducts
'Open "e:\VB_Excel_IO\Kern_0ducts" For Random As FileNum Len = RecLength
Open "e:\prov_VT_spread\Data\Kern_2ducts" For Random As FileNum Len = RecLength
'Open "Kern_3ducts" For Random As FileNum Len = RecLength
For i = 1 To 123
Kern_0ducts.DCC_ducts = myXLSheet.cells(i, 2)
Kern_0ducts.WS_ducts = myXLSheet.cells(i, 1)
Kern_0ducts.SP_ducts_030 = myXLSheet.cells(i, 3)
Kern_0ducts.Wleg_ducts_030 = myXLSheet.cells(i, 4)
Kern_0ducts.Wyoke_ducts_030 = myXLSheet.cells(i, 5)
Kern_0ducts.SP_ducts_027 = myXLSheet.cells(i, 6)
Kern_0ducts.Wleg_ducts_027 = myXLSheet.cells(i, 7)
Kern_0ducts.Wyoke_ducts_027 = myXLSheet.cells(i, 8)
Kern_0ducts.SP_ducts_023 = myXLSheet.cells(i, 9)
Kern_0ducts.Wleg_ducts_023 = myXLSheet.cells(i, 10)
Kern_0ducts.Wyoke_ducts_023 = myXLSheet.cells(i, 11)
Kern_0ducts.SH_ducts = myXLSheet.cells(i, 12)
Put #FileNum, i, Kern_0ducts
Next i

Close #FileNum
'
Open "e:\prov_VT_spread\Data\Kern_2ducts" For Random As FileNum Len = RecLength

Get FileNum, 103, Kern_0ducts
Debug.Print "DCC=", Kern_0ducts.DCC_ducts
Debug.Print "WS=", Kern_0ducts.WS_ducts
Debug.Print "SP030=", Kern_0ducts.SP_ducts_030
Debug.Print "Wleg030=", Kern_0ducts.Wleg_ducts_030
Debug.Print "Wyoke030=", Kern_0ducts.Wyoke_ducts_030
Debug.Print "SP030=", Kern_0ducts.SP_ducts_027
Debug.Print "Wleg030=", Kern_0ducts.Wleg_ducts_027
Debug.Print "Wyoke030=", Kern_0ducts.Wyoke_ducts_027
Debug.Print "SP030=", Kern_0ducts.SP_ducts_023
Debug.Print "Wleg030=", Kern_0ducts.Wleg_ducts_023
Debug.Print "Wyoke030=", Kern_0ducts.Wyoke_ducts_023
Debug.Print "SH=", Kern_0ducts.SH_ducts
'
Close #FileNum
If ExcelWasNotRunning = True Then
myXL.application.quit
End If

Set myXL = Nothing

End Sub
Sub DetectExcel()
Const WM_USER = 1024
Dim hWnd As Long
hWnd = FindWindow("XLMAIN", 0)
If hWnd = 0 Then
Exit Sub
Else
SendMessage hWnd, WM_USER + 18, 0, 0
End If
End Sub

Whats wrong? Please advice.

Regards, Peter

[Slowdown]

Hoi peter,
Het is makkelijker lezen voor anderen om de code in de codetags te plaatsen.

The problem is that Random file I/O isn't working, that is something for Bernd to fix.