ADO hk hakkında bir bilgi !

[hlojan]

Ben Access database kullanıyorum. Ado ile ekle güncelle bul yapmayı biliyorum sadece

'**********************************************************************************************************
'********************************************* TANIMLAMALAR ***********************************************
' DATABASE YOLU
Const yol As String = "M:\DATA.accdb"

Sub cihazguncel()
'*************************************************************
'********************CİHAZ GÜNCELLE***********************
'*************************************************************
Dim con As Object, rs As Object
Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
rs.Open "select * from [A] where kod='" & Worksheets("Data").Range("t4").Value & "' and sira=" & CDbl(Worksheets("Data").Range("t6").Value) & ";", con, 1, 3

rs("marka").Value = Worksheets("Data").Range("t13").Value
rs("model").Value = Worksheets("Data").Range("t14").Value
rs("seri").Value = Worksheets("Data").Range("t15").Value
rs("musterino").Value = Worksheets("Data").Range("t16").Value
  rs.Update
rs.Close: con.Close
Set rs = Nothing: Set con = Nothing

MsgBox "CİHAZ GÜNCELLENDİ."
End Sub
Sub cihazkaydet()
'*************************************************************
'********************CİHAZ KAYDET**************************
'*************************************************************
Dim conn2 As Object, rs2 As Object
If Worksheets("Data").Range("t6").Value = "" Then
    MsgBox "KOD boş olamaz." & vbLf & "Giriş iptal oldu!", vbCritical, "U Y A R I"
    Exit Sub
End If

Set conn2 = CreateObject("adodb.connection")
Set rs2 = CreateObject("adodb.recordset")
conn2.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
rs2.Open "select * from [A] ;", conn2, 1, 3
rs2.addnew
rs2("kod").Value = Worksheets("Data").Range("t4").Value
rs2("sira").Value = Worksheets("Data").Range("t6").Value
rs2("marka").Value = Worksheets("Data").Range("t13").Value
rs2("model").Value = Worksheets("Data").Range("t14").Value
rs2("seri").Value = Worksheets("Data").Range("t15").Value
rs2("musterino").Value = Worksheets("Data").Range("t16").Value

rs2.Update
rs2.Close: conn2.Close
Set rs2 = Nothing: Set conn2 = Nothing

MsgBox "CİHAZ KAYDEDİLDİ"
End Sub

Sub cihazbul()
'*************************************************************
'********************CİHAZ BULMA***************************
'*************************************************************
Dim con As Object, rs As Object

Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
rs.Open "select * from [A] where kod='" & Worksheets("Data").Range("t4").Value & "' and sira=" & CDbl(Worksheets("Data").Range("T6").Value) & ";", con, 1, 1
If rs.RecordCount > 0 Then
 On Error Resume Next
Worksheets("Data").Range("t13").Value = ""
Worksheets("Data").Range("t14").Value = ""
Worksheets("Data").Range("t15").Value = ""
Worksheets("Data").Range("t16").Value = ""
Worksheets("Data").Range("t13").Value = UCase(Replace(Replace(rs("marka"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("t14").Value = UCase(Replace(Replace(rs("model"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("t15").Value = UCase(Replace(Replace(rs("seri"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("t16").Value = UCase(Replace(Replace(rs("musterino"), "i", "İ"), "ı", "I"))
End If
rs.Close
con.Close
Set rs = Nothing: Set con = Nothing

End Sub

Sub firmabul()
'*************************************************************
'********************FİRMA BULMA***************************
'*************************************************************
Dim con As Object, rs As Object
yol = "M:\DATA.accdb"
Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
rs.Open "select * from [B] where kod='" & Worksheets("Data").Range("t4").Text & "';", con, 1, 1
If rs.RecordCount > 0 Then
 On Error Resume Next
Worksheets("Data").Range("t9").Value = ""
Worksheets("Data").Range("t10").Value = ""
Worksheets("Data").Range("ad80").Value = ""
Worksheets("Data").Range("t9").Value = UCase(Replace(Replace(rs("firma"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("t10").Value = UCase(Replace(Replace(rs("adres"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("ad80").Value = UCase(Replace(Replace(rs("dosya"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("p28").Value = Worksheets("Data").Range("ad81").Value
    Else
    MsgBox " FİRMA BULUNAMADI"
End If
rs.Close
con.Close
Set rs = Nothing: Set con = Nothing
End Sub

Sorum ise ; ÖRNEĞİN

Access tablo : A
Fields : kod sıra marka model seri teklif


ben teklif numarası 5215 olanları excele alt alta yazdırsın istio
aynı teklif numarasına sahip olan bir sürü record var

Örnek koyamıyorum Database paylaşamam

Yardımlarınızı bekliyorum

 

[mancubus]

deneyin.
Sayfa1 ibaresini verilerin aktarılacağı sayfanın ismi ile değiştirmek gerekir.

Sub xlTR_t153123_Acc_Veri_Al()

    Dim i As Long
     
    With CreateObject("ADODB.Recordset")
        .Open "SELECT * FROM A WHERE A.teklif = 5215", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & yol & ";"
        For i = 1 To .Fields.Count - 1
            ThisWorkbook.Worksheets("Sayfa1").Cells(1, i) = .Fields(i).Name
        Next
        ThisWorkbook.Worksheets("Sayfa1").Cells(2, 1).CopyFromRecordset .DataSource
    End With

End Sub

 

[hlojan]

Çok sağol çalışıyor

bişi daha istesem. İstediğim fieldlar gelse

Senin kod database deki bütün fieldları döküyor excele

Teklif 5215 olan

Marka Model Seri diye adlandırılmış fieldlar gelsin sadece

Bu konudada yardımlarınızı bekliyorum

 

[hlojan]

Konu hakkında başka arkadaşlarda yardımcı olabilir hala çözüme ulaşamadım

 

[Orion1]

Kodda ilgili yeri şu şekilde değiştirin.

With CreateObject("ADODB.Recordset")
        .Open "SELECT Marka,Model,Seri FROM A WHERE A.teklif = 5215", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & yol & ";"
        ThisWorkbook.Worksheets("Sayfa1").Cells(2, 1).CopyFromRecordset .DataSource
    End With

 

[hlojan]

Harikasınız Select From Where olayını daha iyi anladım.

Basit virgülle hal oluyormuş
Teşekkürler evren Bey

 

[Orion1]

Harikasınız Select From Where olayını daha iyi anladım.

Basit virgülle hal oluyormuş
Teşekkürler evren Bey

Rica ederim.
İyi çalışmalar.