Kapalı Dosyalardan Veri Aktarımı

M

mukoli

Katılım
4 Eylül 2020
Mesajlar
394
Excel Vers. ve Dili
Excel 2016
Altın Üyelik Bitiş Tarihi
22-11-2022
Kod: 
Option Explicit

Sub Import_Data_Ado()
    Dim Process_Time As Double, File_Folder As String, My_File As String
    Dim My_Connection As Object, My_Recordset As Object, My_Query As String
    Dim S1 As Worksheet, S2 As Worksheet, Store_Name As String
    Dim Old_Calculation_Mode As Integer, Find_Store As Range
    
    Process_Time = Timer
    
    With Application
        .ScreenUpdating = 0
         Old_Calculation_Mode = .Calculation
        .Calculation = -4135
    End With
    
    Set My_Connection = VBA.CreateObject("AdoDb.Connection")
    Set My_Recordset = VBA.CreateObject("AdoDb.Recordset")
              
    File_Folder = ThisWorkbook.Path & "\"
    
    My_File = Dir(File_Folder & "*.xls*")
    
    While My_File <> ""
        If My_File <> ThisWorkbook.Name Then
            My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
            File_Folder & My_File & ";Extended Properties=""Excel 12.0;Hdr=No"""
        
            My_Query = "Select F1 From [Sayfa1$A8:A8]"
            My_Recordset.Open My_Query, My_Connection, 1, 1
            
            If My_Recordset.RecordCount > 0 Then
                Set S1 = ThisWorkbook.Sheets(CStr(Format(My_Recordset.Fields(0).Value, "dd.mm.yyyy")))
                Set S2 = ThisWorkbook.Sheets(CStr(Format(My_Recordset.Fields(0).Value, "dd.mm.yyyy")) & " Gider")
                
                Store_Name = VBA.Split(My_File, " ")(0)
                Set Find_Store = S1.Range("A:A").Find(Store_Name, , , xlWhole)
                
                If Not Find_Store Is Nothing Then
                    S1.Cells(Find_Store.Row, 2).Value = My_Connection.Execute("Select * From [Sayfa1$D8:D8]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 3).Value = My_Connection.Execute("Select * From [Sayfa1$D9:D9]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 4).Value = My_Connection.Execute("Select * From [Sayfa1$D10:D10]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 5).Value = My_Connection.Execute("Select * From [Sayfa1$D11:D11]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 6).Value = My_Connection.Execute("Select * From [Sayfa1$D12:D12]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 8).Value = My_Connection.Execute("Select Sum(F1) From [Sayfa1$K9:K12]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 9).Value = My_Connection.Execute("Select Sum(F1) From [Sayfa1$K13:K15]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 10).Value = My_Connection.Execute("Select * From [Sayfa1$K8:K8]").Fields(0).Value
                End If
            
                Set Find_Store = S2.Range("A:A").Find(Store_Name, , , xlWhole)
                If Not Find_Store Is Nothing Then
                    S2.Cells(Find_Store.Row, 2).Value = My_Connection.Execute("Select * From [Sayfa1$F9:F9]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 3).Value = My_Connection.Execute("Select * From [Sayfa1$K9:K9]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 4).Value = My_Connection.Execute("Select * From [Sayfa1$F10:F10]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 5).Value = My_Connection.Execute("Select * From [Sayfa1$K10:K10]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 6).Value = My_Connection.Execute("Select * From [Sayfa1$F11:F11]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 7).Value = My_Connection.Execute("Select * From [Sayfa1$K11:K11]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 8).Value = My_Connection.Execute("Select * From [Sayfa1$F12:F12]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 9).Value = My_Connection.Execute("Select * From [Sayfa1$K12:K12]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 10).Value = My_Connection.Execute("Select * From [Sayfa1$F13:F13]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 11).Value = My_Connection.Execute("Select * From [Sayfa1$K13:K13]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 12).Value = My_Connection.Execute("Select * From [Sayfa1$F14:F14]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 13).Value = My_Connection.Execute("Select * From [Sayfa1$K14:K14]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 14).Value = My_Connection.Execute("Select * From [Sayfa1$F15:F15]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 15).Value = My_Connection.Execute("Select * From [Sayfa1$K15:K15]").Fields(0).Value
                End If
            End If
            
            If My_Connection.State <> 0 Then My_Connection.Close
            If My_Recordset.State <> 0 Then My_Recordset.Close
        End If
        My_File = Dir
    Wend
    
    Set My_Recordset = Nothing
    Set My_Connection = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    With Application
        .ScreenUpdating = 1
        .Calculation = Old_Calculation_Mode
    End With
    
    MsgBox "Your transaction is complete." & vbCr & vbCr & _
           "Processing time ; " & Format(Timer - Process_Time, "0.00") & " Second", vbInformation
End Sub
Merhaba korhan hocam yardımcı olmuştu bu kodla ilgili onun çalışmasıdır. Ana dosyada aktif sayfa işlem yapmasını istiyorum . Başka sayfadaykende çalışıyor kod . Hata olmaması için a aktif sayfa da sekme ismi uyuşuyorsa işlem yapmasını istiyorum . yardımlarınızı bekliyorum iyi günler dilerim
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,190
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Kod içinde zaten sayfa tanımlaması yapmıştım. Başka sayfada çalıştırsanız dahi hedef dosyalarda A8 hücresinde ki tarihi baz alarak ana dosyanızda eşleşen tarihe bakarak işlem yapılıyor. Yani veriler ilgili tarihe ait sayfaya aktarılıyor. Ama bu durum benim kafamı karıştırıyor derseniz aktarım başlamadan önce ilgili tarihe ait sayfa seçtirilebilir. Ya da sizin dediğiniz gibi sayfa adı kontrolü yapılarak eşleşme olmuyorsa işlem sonlandırılabilir.
 
M

mukoli

Katılım
4 Eylül 2020
Mesajlar
394
Excel Vers. ve Dili
Excel 2016
Altın Üyelik Bitiş Tarihi
22-11-2022
Merhaba hocam kod mükemml çalışıyortekrardan ellerinize sağlık. dediğim gibi sadece aktif sayfadayken işlem yaparsa daha iyi olur kontrol bakımından teşekkür ederim ilginize
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,190
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Veri alınacak klasörde birden fazla dosyanız vardı. Bu dosyaların A8 hücrelerinde bulunan tarihler aynı ise tek dosya için bu kontrolün yapılması yeterli olacaktır. Yok eğer klasör içinde bulunan dosyalarda A8 hücrelerinde bulunan tarihler farklı olabiliyorsa tüm dosyalar için bu kontrolün yapılması daha sağlıklı olur.

Hangi yöntemi tercih edersiniz?
 
M

mukoli

Katılım
4 Eylül 2020
Mesajlar
394
Excel Vers. ve Dili
Excel 2016
Altın Üyelik Bitiş Tarihi
22-11-2022
Merhaba hocam dosyalardaki tarihler aynı olucak hepsi teşekkürler
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,190
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Kodu şu şekilde düzenledim;

Klasör altındaki dosyalarda A8 hücresindeki tarih ana dosyanızda sayfa olarak hiç yoksa ya da ana dosyanızda aktif sayfa ismi ile aynı değilse işlem sonlandırılmaktadır.

C++: 
Option Explicit

Sub Import_Data_Ado()
    Dim Process_Time As Double, File_Folder As String, My_File As String
    Dim My_Connection As Object, My_Recordset As Object, My_Query As String
    Dim S1 As Worksheet, S2 As Worksheet, Store_Name As String, My_Check As Boolean
    Dim Old_Calculation_Mode As Integer, Find_Store As Range
    
    Process_Time = Timer
    
    With Application
        .ScreenUpdating = 0
         Old_Calculation_Mode = .Calculation
        .Calculation = -4135
    End With
    
    Set My_Connection = VBA.CreateObject("AdoDb.Connection")
    Set My_Recordset = VBA.CreateObject("AdoDb.Recordset")
              
    File_Folder = ThisWorkbook.Path & "\"
    
    My_File = Dir(File_Folder & "*.xls*")
    
    While My_File <> ""
        If My_File <> ThisWorkbook.Name Then
            My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
            File_Folder & My_File & ";Extended Properties=""Excel 12.0;Hdr=No"""
        
            My_Query = "Select F1 From [Sayfa1$A8:A8]"
            My_Recordset.Open My_Query, My_Connection, 1, 1
            
            If My_Recordset.RecordCount > 0 Then
                On Error Resume Next
                Set S1 = Nothing
                Set S2 = Nothing
                Set S1 = ThisWorkbook.Sheets(CStr(Format(My_Recordset.Fields(0).Value, "dd.mm.yyyy")))
                Set S2 = ThisWorkbook.Sheets(CStr(Format(My_Recordset.Fields(0).Value, "dd.mm.yyyy")) & " Gider")
                On Error GoTo 0
                
                If Not S1 Is Nothing And Not S2 Is Nothing Then
                    If ThisWorkbook.ActiveSheet.Name <> S1.Name Or ThisWorkbook.ActiveSheet.Name <> S2.Name Then
                        My_Check = True
                        GoTo 10
                        Exit Sub
                    End If
                Else
                    My_Check = True
                    GoTo 10
                End If
                    
                Store_Name = VBA.Split(My_File, " ")(0)
                Set Find_Store = S1.Range("A:A").Find(Store_Name, , , xlWhole)
                
                If Not Find_Store Is Nothing Then
                    S1.Cells(Find_Store.Row, 2).Value = My_Connection.Execute("Select * From [Sayfa1$D8:D8]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 3).Value = My_Connection.Execute("Select * From [Sayfa1$D9:D9]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 4).Value = My_Connection.Execute("Select * From [Sayfa1$D10:D10]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 5).Value = My_Connection.Execute("Select * From [Sayfa1$D11:D11]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 6).Value = My_Connection.Execute("Select * From [Sayfa1$D12:D12]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 8).Value = My_Connection.Execute("Select Sum(F1) From [Sayfa1$K9:K12]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 9).Value = My_Connection.Execute("Select Sum(F1) From [Sayfa1$K13:K15]").Fields(0).Value
                    S1.Cells(Find_Store.Row, 10).Value = My_Connection.Execute("Select * From [Sayfa1$K8:K8]").Fields(0).Value
                End If
            
                Set Find_Store = S2.Range("A:A").Find(Store_Name, , , xlWhole)
                If Not Find_Store Is Nothing Then
                    S2.Cells(Find_Store.Row, 2).Value = My_Connection.Execute("Select * From [Sayfa1$F9:F9]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 3).Value = My_Connection.Execute("Select * From [Sayfa1$K9:K9]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 4).Value = My_Connection.Execute("Select * From [Sayfa1$F10:F10]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 5).Value = My_Connection.Execute("Select * From [Sayfa1$K10:K10]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 6).Value = My_Connection.Execute("Select * From [Sayfa1$F11:F11]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 7).Value = My_Connection.Execute("Select * From [Sayfa1$K11:K11]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 8).Value = My_Connection.Execute("Select * From [Sayfa1$F12:F12]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 9).Value = My_Connection.Execute("Select * From [Sayfa1$K12:K12]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 10).Value = My_Connection.Execute("Select * From [Sayfa1$F13:F13]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 11).Value = My_Connection.Execute("Select * From [Sayfa1$K13:K13]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 12).Value = My_Connection.Execute("Select * From [Sayfa1$F14:F14]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 13).Value = My_Connection.Execute("Select * From [Sayfa1$K14:K14]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 14).Value = My_Connection.Execute("Select * From [Sayfa1$F15:F15]").Fields(0).Value
                    S2.Cells(Find_Store.Row, 15).Value = My_Connection.Execute("Select * From [Sayfa1$K15:K15]").Fields(0).Value
                End If
            End If
            
            If My_Connection.State <> 0 Then My_Connection.Close
            If My_Recordset.State <> 0 Then My_Recordset.Close
        End If
        My_File = Dir
    Wend
    
10  If My_Connection.State <> 0 Then My_Connection.Close
    If My_Recordset.State <> 0 Then My_Recordset.Close
    
    Set My_Recordset = Nothing
    Set My_Connection = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    With Application
        .ScreenUpdating = 1
        .Calculation = Old_Calculation_Mode
    End With
    
    If My_Check = False Then
        MsgBox "Your transaction is complete." & vbCr & vbCr & _
               "Processing time ; " & Format(Timer - Process_Time, "0.00") & " Second", vbInformation
    Else
        MsgBox "The transaction was terminated because the dates did not match.", vbCritical
    End If
End Sub
 
M

mukoli

Katılım
4 Eylül 2020
Mesajlar
394
Excel Vers. ve Dili
Excel 2016
Altın Üyelik Bitiş Tarihi
22-11-2022
Teşekkür Ederim hocam hemen uyguluyorum ellerinize sağlık
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst