Hente ut streng i tekstfil

[Sjenever]

Håper noen kan hjelpe meg med dette.

 

Jeg har en tekstfil som inneholder: "navn","www.minside.no"

Jeg vil hente ut: "navn" og legge den i en listboks.

Når jeg så klikker på "navn" i listboksen så skal "www.minside.no" åpnes/aktiveres.

 

Koden jeg bruker nå tar med alt i strengen.

Private Sub Form_Load()

   wbBrowser.Navigate cboURL.Text
   
Dim item As String
    On Error GoTo Error_Handler
    Open "fav.dat" For Input As #1
   Do Until EOF(1)
     Line Input #1, item
     lstFav.AddItem item
   Loop
     Close #1
   Exit Sub
   
   Error_Handler:
      MsgBox "Ingen URL i listen"

End Sub

[aadnk]

Du kan f.eks gjøre slik:

 

Private Type Data
   sName As String
   sAddress As String
End Type

Dim aData() As Data

Private Sub Form_Load()

  wbBrowser.Navigate cboURL.Text
  
Dim item As String, Tell As Long, Tmp
   On Error GoTo Error_Handler
   Open "fav.dat" For Input As #1
  Do Until EOF(1)
  
    Line Input #1, item
    
    Tmp = Split(item, ",")
    
    ReDim Preserve aData(Tell)
    
    aData(Tell).sName = Tmp(0)
    aData(Tell).sAddress = Tmp(1)
    Tell = Tell + 1
    
  Loop
    Close #1
    
    Update
    
  Exit Sub
  
Error_Handler:
     MsgBox "Ingen URL i listen"

End Sub

Public Sub Update()

Dim Tell As Long

lstFav.Clear

For Tell = LBound(aData) To UBound(aData)
   lstFav.AddItem aData(Tell).sName
Next

End Sub

Private Sub lstFav_Click()

wbBrowser.Navigate aData(lstFav.ListIndex).sAddress

End Sub

[Sjenever]

Takker så mye.

Dere har vært til stor hjelp.

[Sjenever]

Du kan f.eks gjøre slik:

 

Private Type Data
   sName As String
   sAddress As String
End Type

Dim aData() As Data

Private Sub Form_Load()

  wbBrowser.Navigate cboURL.Text
  
Dim item As String, Tell As Long, Tmp
   On Error GoTo Error_Handler
   Open "fav.dat" For Input As #1
  Do Until EOF(1)
  
    Line Input #1, item
    
    Tmp = Split(item, ",")
    
    ReDim Preserve aData(Tell)
    
    aData(Tell).sName = Tmp(0)
    aData(Tell).sAddress = Tmp(1)
    Tell = Tell + 1
    
  Loop
    Close #1
    
    Update
    
  Exit Sub
  
Error_Handler:
     MsgBox "Ingen URL i listen"

End Sub

Public Sub Update()

Dim Tell As Long

lstFav.Clear

For Tell = LBound(aData) To UBound(aData)
   lstFav.AddItem aData(Tell).sName
Next

End Sub

Private Sub lstFav_Click()

wbBrowser.Navigate aData(lstFav.ListIndex).sAddress

End Sub

Har støtt på et lite problem. Når filen fav.dat er tom eller ikke er tilstede får jeg opp en feilmelding. "Runtime error '9'

subscript out of range"

 

Det ser ut til å være noe med denne koden.

Public Sub Update()
Dim Tell As Long

   lstFav.Clear

For Tell = LBound(aData) To UBound(aData)
   
   lstFav.AddItem aData(Tell).sName
Next

End Sub

 

Har forsøkt å legge til denne.

On Error Resume Next
          

Får da ikke opp noen error når jeg kjøre programmet i VB. Kjører jeg den utenom henger programmet seg.

[GeirGrusom]

Egentlig så kan du bare bytte ut "line input" med "input"...

[aadnk]

Det er dette som irriterer med UBound og LBound prosedyrene, de kaller feilhåndtereren når array-en er tom. Det finnes flere måter å gå rundt dette på. En, mer avansert løsning, er å bruke disse selvlagde funksjonene:

 

' Legg denne koden inn i en modul
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long

Public Function SafeUBound(ByVal lpArray As Long, Optional Dimension As Long = 1) As Long

On Error Resume Next
Dim lAddress&, cElements&, lLbound&, cDims%

If Dimension < 1 Then
   SafeUBound = -1
   Exit Function
End If

CopyMemory lAddress, ByVal lpArray, 4

If lAddress = 0 Then
   ' The array isn't initilized
   SafeUBound = -1
   Exit Function
End If

' Calculate the dimenstions
CopyMemory cDims, ByVal lAddress, 2
Dimension = cDims - Dimension + 1

' Obtain the needed data
CopyMemory cElements, ByVal (lAddress + 16 + ((Dimension - 1) * 8)), 4
CopyMemory lLbound, ByVal (lAddress + 20 + ((Dimension - 1) * 8)), 4

SafeUBound = cElements + lLbound - 1

End Function

Public Function SafeLBound(ByVal lpArray As Long, Optional Dimension As Long = 1) As Long

On Error Resume Next
Dim lAddress&, cElements&, lLbound&, cDims%

If Dimension < 1 Then
   SafeLBound = -1
   Exit Function
End If

CopyMemory lAddress, ByVal lpArray, 4

If lAddress = 0 Then
   ' The array isn't initilized
   SafeLBound = -1
   Exit Function
End If

' Calculate the dimenstions
CopyMemory cDims, ByVal lAddress, 2
Dimension = cDims - Dimension + 1

' Obtain the needed data
CopyMemory lLbound, ByVal (lAddress + 20 + ((Dimension - 1) * 8)), 4

SafeLBound = lLbound

End Function

 

Etter du har gjort dette, kan du f.eks endre prosedyren Update til dette:

 

Public Sub Update()

Dim Tell As Long

lstFav.Clear

For Tell = Abs(SafeLBound(VarPtrArray(aData))) To SafeUBound(VarPtrArray(aData))
  lstFav.AddItem aData(Tell).sName
Next

End Sub

[Sjenever]

Tusen takk aadnk.

Det var dette som skulle til. Skjønner ikke hvor du tar det fra. Dette hadde jeg aldri funnet ut selv. :-)