ADO UPDATE SQL Table/Record

tamer42 · 18 Mayıs 2023

Merhaba,

Ekli dosya içinde Ürün Bilgileri bulunmakata;

Aynı Ürün Kodu hem Kategori alanında hem "standart" hemde "trend" olarak bulunmakta;

Yapmak istediğim bu dosya kapalı iken ADO Connection ile ulaşıp;
Kategori alanında "trend" olanların barkodunu, aynı ürün kodunda Kategorisi "Standart" olanlarda bulucak ve "trend" satırında güncelleyecek.
Örnek:
Ürün Kodu 4467 olan ürünün barkodu "standart" kategorisinde barkodunu bulacak 4464G4zycn05 ve bu değeri trend kategorisinde ürün kodunun olduğu satırda güncelleyecek.
Özetle trend kategorisinde yer alan ürünün barkodunu, ürün kodunu referans alarak standart kategorisinden alıp getirecek.

Aşağıdaki şekilde bir kurgu oluşturmaya çalşıtım yalnız buraya ürün kodlarını yerleştiremedim,

desteğiniz için teşekkürler,
iyi Çalışmalar.

Kod:

Sub UseFileDialogOpen()
 
    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    With fd
        .Filters.Clear
        .Title = "Select an Excel File"
        .Filters.Add "Excel Files", "*.xlsx?", 1
        .AllowMultiSelect = False
        
        Dim sFile As String
        sFile = ""
        
        If .Show = True Then
            sFile = .SelectedItems(1)
        End If
    End With
    
    If sFile <> "" Then UpdateTable sFile
 
End Sub

Kod:

Sub UpdateTable(myFile As String)
Dim Con As Object
Dim RS As Object

Set Con = VBA.CreateObject("adodb.Connection")

Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
myFile & ";extended properties=""Excel 12.0;Hdr=Yes;IMEX=1"""

    uSQL = "Update [data$] Set [Barcode]=(Select [Barcode] From [data$] " & _
    "Where [Kategori] = 'Standart')"
    
  Con.Execute uSQL
   
Con.Close
Set Con = Nothing

End Sub

tamer42 · 19 Mayıs 2023

tamer42' Alıntı:
Merhaba,

Ekli dosya içinde Ürün Bilgileri bulunmakata;

Aynı Ürün Kodu hem Kategori alanında hem "standart" hemde "trend" olarak bulunmakta;

Yapmak istediğim bu dosya kapalı iken ADO Connection ile ulaşıp;
Kategori alanında "trend" olanların barkodunu, aynı ürün kodunda Kategorisi "Standart" olanlarda bulucak ve "trend" satırında güncelleyecek.
Örnek:
Ürün Kodu 4467 olan ürünün barkodu "standart" kategorisinde barkodunu bulacak 4464G4zycn05 ve bu değeri trend kategorisinde ürün kodunun olduğu satırda güncelleyecek.
Özetle trend kategorisinde yer alan ürünün barkodunu, ürün kodunu referans alarak standart kategorisinden alıp getirecek.

Aşağıdaki şekilde bir kurgu oluşturmaya çalşıtım yalnız buraya ürün kodlarını yerleştiremedim,

desteğiniz için teşekkürler,
iyi Çalışmalar.

Kod:

Merhabalar,
UPDATE olayı ilegili aşağıdaki şekilde bir çözüm ürettim ama;
Öncelikle güncellenecek kodları bir dizi içine aldım;

sonra for ... next döngüsüyle tek-tek güncelledim, yalnız bu şekilde oldukça uzun oldu, kısaltmak mümkün müdür?

Teşekkürler, iyi Çalışmalar.

Kod:

Sub UpdateTable(myFile As String)
Dim Con As Object
Dim RS As Object
Dim uSQL As String, iSQL As String
Dim raf As String, ac As String
Dim Veri As Variant

Set Con = VBA.CreateObject("adodb.Connection")
Set RS = VBA.CreateObject("adodb.Recordset")

Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
myFile & ";extended properties=""Excel 12.0;Hdr=Yes;IMEX=0"""

    uSQL = "Select DISTINCT [Ürün Kodu] From [sayfa$] " & _
    "Where [Kategori] <> 'standart'"
    
 RS.Open uSQL, Con, 3, 1

Veri = RS.getrows

uSQL = ""
RS.Close

' ' ' ' ' '

For i = LBound(Veri, 2) To UBound(Veri, 2)
    raf = Veri(0, i)
    
     iSQL = "Select [Barcode] From [sayfa$] " & _
    "Where [Kategori] = 'standart' And [Ürün Kodu]= " & raf & ""
    
     RS.Open iSQL, Con, 3, 1
     
     If RS.RecordCount > 0 Then
     
         If RS(0) <> "" Then
            ac = RS(0)
         
            iSQL = ""
            RS.Close
    
             uSQL = "Update [sayfa$] SET [Barcode] = '" & ac & "'" & _
            " WHERE [Ürün Kodu]= " & raf & " And [Kategori] <> 'standart' "
            
            Con.Execute uSQL
            
         End If
         
     End If
     
    ac = ""
    
    iSQL = ""
    On Error Resume Next
    RS.Close
    On Error GoTo 0
    raf = ""
    
Next i


Con.Close
Set Con = Nothing

MsgBox "İşlem Tamam", vbOKOnly, "Bilgi"

End Sub

dost · 20 Mayıs 2023

Merhaba,

C++:

Sub UpdateTable(myFile As String)
Dim Con, RS As Object
Dim uSQL As String

Set Con = VBA.CreateObject("adodb.Connection")
Set RS = VBA.CreateObject("adodb.Recordset")

Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
myFile & ";extended properties=""Excel 12.0;Hdr=Yes;IMEX=0"""

uSQL = "SELECT * " & _
         "FROM [Data$] " & _
         "WHERE [Ürün Kaynagi] = 'standart' "

RS.Open uSQL, Con, 3, 1
uSQL = ""

If (Not RS.BOF) Then
    RS.MoveFirst
    Do While Not RS.EOF
        uSQL = "Update [Data$] SET [Barcode] = '" & RS(2) & "'" & _
                " WHERE [Ürün Kodu]= " & RS(0) & " And [Ürün Kaynagi] <> 'standart' "

        Con.Execute uSQL
        RS.movenext
    Loop
End If

uSQL = ""
RS.Close:     Con.Close
Set Con = Nothing:  Set RS = Nothing

MsgBox "İşlem Tamam", vbOKOnly, "Bilgi"

End Sub

tamer42 · 20 Mayıs 2023

dost' Alıntı:

Merhaba,

C++:

Sub UpdateTable(myFile As String)
Dim Con, RS As Object
Dim uSQL As String

Set Con = VBA.CreateObject("adodb.Connection")
Set RS = VBA.CreateObject("adodb.Recordset")

Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
myFile & ";extended properties=""Excel 12.0;Hdr=Yes;IMEX=0"""

uSQL = "SELECT * " & _
         "FROM [Data$] " & _
         "WHERE [Ürün Kaynagi] = 'standart' "

RS.Open uSQL, Con, 3, 1
uSQL = ""

If (Not RS.BOF) Then
    RS.MoveFirst
    Do While Not RS.EOF
        uSQL = "Update [Data$] SET [Barcode] = '" & RS(2) & "'" & _
                " WHERE [Ürün Kodu]= " & RS(0) & " And [Ürün Kaynagi] <> 'standart' "

        Con.Execute uSQL
        RS.movenext
    Loop
End If

uSQL = ""
RS.Close:     Con.Close
Set Con = Nothing:  Set RS = Nothing

MsgBox "İşlem Tamam", vbOKOnly, "Bilgi"

End Sub

Teşekkürler Hocam;

tamer42 · 21 Mayıs 2023

dost' Alıntı:
Merhaba,

Merhaba Bu kodda bir sorun oluştu,
Ekli dosyada C7 hücresinde yazan metini güncellerken ekli hata mesajını veriyor,

font style='FONT-FAMILY: "times new roman", "serif"'><SPAN><SPAN class=size style="FONT-SIZE: 12pt">

sanırsam buradaki " işaretleri sorun oluyor, çözüm konuda ne önerirsiniz?
desteğiniz için şimdiden teşekkürler,
iyi pazarlar.

Kod:

Sub UseFile()
 Dim sFile As String
 
    sFile = ThisWorkbook.Path & "\Urunler.xlsx"
   
    UpdateTable2 sFile
 
End Sub

Kod:

Sub UpdateTable2(myFile As String)
Dim Con, RS As Object
Dim uSQL As String

Set Con = VBA.CreateObject("adodb.Connection")
Set RS = VBA.CreateObject("adodb.Recordset")

Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
myFile & ";extended properties=""Excel 12.0;Hdr=Yes;IMEX=0"""

uSQL = "SELECT * " & _
         "FROM [sayfa$] " & _
         "WHERE [Kategori] = 'standart' "

RS.Open uSQL, Con, 3, 1
uSQL = ""

If (Not RS.BOF) Then
    RS.MoveFirst
    Do While Not RS.EOF
        uSQL = "Update [sayfa$] SET [Barcode] = '" & RS(2) & "'" & _
                " WHERE [Ürün Kodu]= " & RS(0) & " And [Kategori] <> 'standart' "

        Con.Execute uSQL
        RS.MoveNext
    Loop
End If

uSQL = ""
RS.Close:     Con.Close
Set Con = Nothing:  Set RS = Nothing

MsgBox "İşlem Tamam", vbOKOnly, "Bilgi"

End Sub

dost · 21 Mayıs 2023

Merhaba

uSQL satırından sonra aşağıdaki kodu ekleyin bence.

C++:

On Error Resume Next

tamer42 · 21 Mayıs 2023

dost' Alıntı:
Merhaba

uSQL satırından sonra aşağıdaki kodu ekleyin bence.

C++:

On Error Resume Next

Hocam peki bu durumda güncellemeyi yapacak mı?
önemli olan güncellemeyi yaptırmak.
teşekkürler,

ADO UPDATE SQL Table/Record

tamer42

Destek Ekibi

Ekli dosyalar

tamer42

Destek Ekibi

dost

tamer42

Destek Ekibi

tamer42

Destek Ekibi

Ekli dosyalar

dost

tamer42

Destek Ekibi