ListBox'a metin türünde veri almak

[unfors]

"CAD DOSYALARI | BELGELER | KESIM LISTESI | PROJE | GORSEL | MALIYET | DIGER " seklinde "|" işareti ile ayırdığım metinleri Access Data'dan Listbox'a satır satır almak istiyorum.
Listbox1.List = Split(rs("DURUM").Value, "|") şeklinde yaptığımda 255 karakter sınırına takılıyorum. Bunun başka bir yöntemi var mı?

 

[Orion1]

Örenk dosya için link verirseniz daha çabuk cevap alabilirsiniz.

 

[unfors]

https://dosya.co/xpwtjuqiuydl/Yeni_klasör.rar.html

 

[Orion1]

vt de null olan satırları silin.
kod aşağıdadır.

Private Sub UserForm_Initialize()
Dim a, i As Integer
'On Error Resume Next
Call Ado_Baglan
Set rs = CreateObject("Adodb.RecordSet")
Sorgu = "SELECT DISTINCT * from [IS_EMIRLERI] where [IS_KODU] ='" & TextBox1.Value & "'"
rs.Open Sorgu, con, 1, 3
rs.movefirst
Do While Not rs.EOF
    a = Split(rs("DURUM_NOT").Value, "|")
    For i = 0 To UBound(a)
        ListBox1.AddItem a(i)
    Next
    'ListBox1.List = Split(rs("DURUM_NOT").Value, "|")
rs.MoveNext
Loop
rs.Close: con.Close: Set con = Nothing: Set rs = Nothing: Sorgu = ""
End Sub

 

[unfors]

"vt de null olan satırları silin." dediğiniz hangileri anlamadım! Kodu olduğu gibi kullandım ama aynı sonucu aldım. 255 karakteri geçmiyor yine

 

[Orion1]

Aşağıdaki kırmızı satırları koyun.
Bende yolladığınız dosya bu şekilde çalışıyor.

Do While Not rs.EOF
    If Not IsNull(rs("DURUM_NOT").Value) Then
        a = Split(rs("DURUM_NOT").Value, "|")
        For i = 0 To UBound(a)
            ListBox1.AddItem a(i)
        Next
    End If
rs.MoveNext
Loop

 

[unfors]

Orion1 hocam bende sonuç değişmiyor. Office 2019 x32 kullanıyorum. Bununla alakası olduğunu da düşünmüyorum. Dosyanın sizde çalışan halini gönderebilirseniz çok sevinirim.

 

[Orion1]

Orion1 hocam bende sonuç değişmiyor. Office 2019 x32 kullanıyorum. Bununla alakası olduğunu da düşünmüyorum. Dosyanın sizde çalışan halini gönderebilirseniz çok sevinirim.

Aşağıaki linkte.
Winrarın içinden çıkarıp öyle çalıştırın.

DOSYAYI INDIR

 

[unfors]

hocam sonuç bu şekilde görünüyor

 

[unfors]

Sorgu = "SELECT *from [IS_EMIRLERI] where [IS_KODU] ='" & TextBox1.Value & "'"

sorgu ifadesindeki tekrarı önlemek için koyduğum "DISTINCT" ifadesini kaldırınca sonuç doğru oluyor ama tekrarlı olarak devam ediyor.

 

[unfors]

Sorgu = "SELECT [IS_KODU],[DURUM_NOT] from [IS_EMIRLERI] where [IS_KODU] ='" & TextBox1.Value & "' group by [IS_KODU],[DURUM_NOT]"

şeklinde gruplayarak denediğimde de sonuç 2 üstteki resimdeki gibi oluyor.

 

[Orion1]

Aşağıdaki gibi deneyiniz.

Private Sub UserForm_Initialize()
Dim a, i As Integer, z As Object
ListBox1.Clear
Set z = CreateObject("scripting.dictionary")
Call Ado_Baglan
Set rs = CreateObject("Adodb.RecordSet")
Sorgu = "SELECT * from [IS_EMIRLERI] where [IS_KODU] ='" & TextBox1.Value & "'"
rs.Open Sorgu, con, 1, 3
rs.movefirst
Do While Not rs.EOF
    If Not IsNull(rs("DURUM_NOT").Value) Then
        a = Split(rs("DURUM_NOT").Value, "|")
        For i = 0 To UBound(a)
            If Not z.exists(a(i)) Then
                z.Add (a(i)), Nothing
            End If
        Next
    End If
rs.MoveNext
Loop
If z.Count > 0 Then ListBox1.List = z.keys
rs.Close: con.Close: Set con = Nothing: Set rs = Nothing: Sorgu = ""
End Sub

 

[unfors]

Elinize emeğinize sağlık hocam. Sayenizde hem sorunum çözüldü hem de yeni bir şey öğrendim. Çok teşekkür ederim.

 

[Orion1]

Elinize emeğinize sağlık hocam. Sayenizde hem sorunum çözüldü hem de yeni bir şey öğrendim. Çok teşekkür ederim.

Rica ederim.
İyi çalışmalar.