İşlem, Güncelleştirilebilir bir sorgu kullanmalıdır!

[tamer42]

Merhaba,

Ekli dosyda veriyi günceleştirmek isterken ekli hata mesajını vermekte;

yardımlarınız için teşekkürler,
iyi çalışmalar.

Public Sub verticalUpdate(ByVal Alan As String, ByVal ie As Variant, item As Variant, deger As String)
Dim RS As ADODB.Recordset
Dim veri As Variant
Dim SQL As String

   On Error GoTo ErrorHandler
 
    ' - ' - ' - ' - ' - ' - ' - ' - ' - ' - ' - ' - ' - ' - ' - '
    SQL = "UPDATE [Data$] SET [Not] ='" & deger & "'" & _
        " WHERE [IE] =" & ie & " AND [Item] =" & item

    Set RS = Con.Execute(SQL)
    ' - ' - ' - ' - ' - ' - ' - ' - ' - ' - ' - ' - ' - ' - ' -

 Exit Sub

ErrorHandler:

MsgBox "Error # " & CStr(Err.Number) & " " & Err.Description

Err.Clear

End Sub

 

[Haluk]

Bağlantıda IMEX=1 kısmını silin, çalışır....

.

 

[tamer42]

Bağlantıda IMEX=1 kısmını silin, çalışır....

.

Haluk Hocam selamlar,
Aşağıdaki kod ile;
Bir sayfadaki verileri 2 koşula göre; aynı dosya içinden başka bir sayfadan Adet verilerini çekebiliyoruz.,
Burada bir sorun yok, yalnız bire-bir aynı olan kaynak verileri (Sayfa) başka bir dosyadan almak istediğim zaman;
" INNER JOIN [" & WB1 & "].[Sayfa$] AS T2"
buradaki WB1 yerini WB2 olarak değiştirdiğimizde ekli görseldeki hata mesajını veriyor.
Özetle Aynı dosya içinde olduğu zaman çalışıyor, kaynak sayfa başka bir dosyada olduğu zaman hata mesajı veriyor.
Bunun bir çözümü var mıdır?

Not: For......Next döngüsünde satır-satır verileri yazdırmak mümkün fakat bu işlem biraz uzun sürüyor, For......Next döngüsünde girmeden pratik bir çözüm arayışındayım.

Anlayışınınz için teşekkürler,
iyi çalışmalar.

Sub test()
Dim Cn As Object
Dim myPath As String
Dim WB1 As String
Dim WB2 As String
Dim SH As Worksheet

Set SH = Sheets("Data")

    myPath = ActiveWorkbook.Path
    WB1 = ActiveWorkbook.FullName

    WB2 = myPath & "\Kaynak.xlsx"
    
  LR = SH.Cells(SH.Rows.Count, "A").End(xlUp).Row

    SH.Range("F2:F" & LR).ClearContents
    
Set Cn = CreateObject("ADODB.CONNECTION")
  
    With Cn
        .Open "Provider=Microsoft.Ace.Oledb.12.0;Extended Properties='Excel 12.0;HDR=YES;IMEX=0';Data Source=" & _
               WB1
        
        .Execute " UPDATE [" & WB1 & "].[Data$] AS T1" & _
                 " INNER JOIN [" & WB1 & "].[Sayfa$] AS T2" & _
                 " ON (T1.IE = T2.IE AND T1.Item = T2.Item)" & _
                 " SET T1.Adet = T2.Adet"
        .Close
        
    End With

End Sub

 

[dost]

Merhaba,

Aşağıdaki kodu dener misin. (Aklıma gelen yöntem)

Sub test()
Dim Cn As Object, adoCN As Object, RS As Object
Dim myPath As String, WB1 As String, WB2 As String, strSQL As String
Dim SH As Worksheet, ws As Worksheet
Dim i As Integer
Dim wsCtrl As Boolean

Set SH = Sheets("Data")

myPath = ActiveWorkbook.Path
WB1 = ActiveWorkbook.FullName
WB2 = myPath & "\Kaynak.xlsx"

Set adoCN = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.Recordset")

adoCN.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & WB1 & _
                    ";Extended Properties='Excel 12.0 Macro;HDR=YES;IMEX=1'"
                    
'**** Update etmeden önce verileri bu çalışma kitabındaki tmp sayfasına al ****
wsCtrl = False
For Each ws In ThisWorkbook.Worksheets
    If ws.Name = "tmpSh" Then
        wsCtrl = True:  Exit For
    End If
Next ws
If wsCtrl = False Then Sheets.Add.Name = "tmpSh"

strSQL = "SELECT DISTINCT t2.IE, t2.Item, t2.Adet " & _
         "FROM [Data$] t1  " & _
         "INNER JOIN [" & WB2 & "].[Sayfa$] AS t2  " & _
         "ON (t1.IE = t2.IE AND t1.Item = t2.Item) "

Set RS = adoCN.Execute(strSQL)
    
For i = 0 To RS.Fields.Count - 1
    Sheets("tmpSh").Cells(1, i + 1) = RS(i).Name
Next

Sheets("tmpSh").Range("A2").CopyFromRecordset RS
  
LR = SH.Cells(SH.Rows.Count, "A").End(xlUp).Row

SH.Range("F2:F" & LR).ClearContents
    
Set Cn = CreateObject("ADODB.CONNECTION")
 
'**** Update işlemindeki Join'i tmp sayfası ile kur****
With Cn
    .Open "Provider=Microsoft.Ace.Oledb.12.0;Extended Properties='Excel 12.0;HDR=YES;IMEX=0';Data Source=" & _
           WB1
    .Execute " UPDATE [Data$] AS T1" & _
             " INNER JOIN [tmpSh$] AS T2" & _
             " ON (T1.IE = T2.IE AND T1.Item = T2.Item)" & _
             " SET T1.Adet = T2.Adet"
    .Close
End With

Sheets("tmpSh").Delete

adoCN.Close:    RS.Close
Set Cn = Nothing:   Set adoCN = Nothing:    Set adoCN = Nothing:  Set SH = Nothing

End Sub