İşlem Yaptıktan Sonra Alt Klasördeki Dosyalar Silinme

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, 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
Merhaba bu makro işlemi yapıldıktan sonra klasör altındaki excel dosyalarının silinmesini nasıl sağlayabiliriz. İşlem bittikten sonra sadece ana dosya kalıcak teşekkürler şimdiden iyi pazarlar herkese
 
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
Korhan hocam uygulamış oldugu kodda birşey daha eklenebilirmi . Bu kodda ana sekme ismi le alt klasördeki dosyaların a8 bakarak uyuşma oluyorsa işlem yapıyor herhangi sıkıntı yok diyelim 50 tane dosya var birtanesinde uyuşmazlık var çalışmıyor program ve ben tek tek bakmak zorunda kalıyorum. Hangisinde hata oldugunu mesaj olarak söyleme şansı varmıdır
 
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
Yardım edicek üstad varmıdır
 
Son düzenleme:
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,307
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Kodu aşağıdaki şekilde revize edip deneyiniz.

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 Then My_Check = True
                    If ThisWorkbook.ActiveSheet.Name = S2.Name Then My_Check = True
                    If My_Check = False Then GoTo 10
                Else
                    My_Check = False
                    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
            Kill File_Folder & My_File
        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 = True 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." & vbCr & vbCr & _
               "The date does not match in the file below." & vbCr & vbCr & My_File, 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
Merhaba hocam kod çalışıyor hatalı olan dosyayı söylüyor fakat şu sorun var diyelim ben 11.11.2021 sekmesinde işlem yapıcam ama aktarıcagım dosyalarda 10.11.2021 yada 09.11.2021 bunlar var onlarıda aktarıyor dosyada o tarihe ait sayfalar oldugu için . Ben aktif sayfadaykan 11.11.2021 ise dosyalar aktarılsın değilse hatalı dosyayı söylesin istiyorum çok şey isityorum k.bakmayın nolur tekrardn ellerinize sağlık
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst