ExcelDepo
Site Kurucusu
Klasör sıralamasını Tür şeklinde yapıp, kolayca klasör üzerinden silebilirsiniz.
Excel ile silme işlemine iten sebep nedir?
Excel ile silme işlemine iten sebep nedir?
Ju Programm kissen degil is amacli kullanacagim ve uzanti bölümünü (txt, xlx , ppt vb) yapiöacak islemi ( Silme , sayma, tasima) interaktiv hale getirip cok amacli olarak kullanmayi düsünüyorum.
CPP:
Görüntülemek için giriş yapmanız gerekmektedir.
(13 satır)
Code değil kod hocam. Sadece çalışmadı demek anlamsız oluyor. Hata mı verdi, kod hiç mi çalışmadı vs. gibi daha net bilgi vermeniz doğrudur.Kod benim bilgisayarımda çok net çalışıyor, kullandığım bir kod hatta.
Kod içersindeki klasor yolunu kendi bilgisayarınıza göre düzelteceksiniz.
Tekrardan merhabalar
Bahadir beyin düsündügü gibi yurtisindanim, bu sekilde olan ve olabilecek yazim hatalari icin simdiden özü dilerim.
Calismama konusu gelecek olursak C:\Users\ersano\Desktop\New folder (3) dosyasinin altina iki dosya ekledim ve en son dosyanin icinde bulunan excel datalarinin silinmesini istiyorum. KOD herhangi bir hata vermiyor ama excel dosyasinida silmiyor.
Ekli dosyayı görüntüle 7065
Ekli dosyayı görüntüle 7066
Ekli dosyayı görüntüle 7067
Bahadir beyin düsündügü gibi yurtisindanim, bu sekilde olan ve olabilecek yazim hatalari icin simdiden özü dilerim.
Calismama konusu gelecek olursak C:\Users\ersano\Desktop\New folder (3) dosyasinin altina iki dosya ekledim ve en son dosyanin icinde bulunan excel datalarinin silinmesini istiyorum. KOD herhangi bir hata vermiyor ama excel dosyasinida silmiyor.
Ekli dosyayı görüntüle 7065
Ekli dosyayı görüntüle 7066
Ekli dosyayı görüntüle 7067
Ekli dosyalar
Eklediğiniz resimlerde gördüğüm ve anladığı kadarıyla ikinci bir alt klasör mevcut bu durumda kodlarda değişiklik olması gerek.
Aşağıdaki kodu deneyin.
VBA:
Görüntülemek için giriş yapmanız gerekmektedir.
(22 satır)
Moderatörün son düzenlenenleri:
Hocam Hizli dönüsleriniz icin tesekkür ederim
gönderdiginiz kodu calistirdim bu kod sadece en alt klasördeki dosyalari sildi digerleri malesef kaldi.
Ekte gönderdigim kod istedigim klasörü detayli olarak inceleyip listeliyor sizce bu koda nasil bir ekleme yaparsak belirttigimiz dosya tipleri siler ?
Option Explicit
Option Compare Text
Const sRootPath As String = "C:\Users\ersano\Desktop\New folder (3)" 'Pfad bitte anpassen ohne Trennzeichen am Ende!!!
Private lRowCounter As Long
Private oSheet As Object
'Start der Routine: Call MWDateienMitUnterordnernAuslesen
Public Sub MWDateienMitUnterordnernAuslesen()
Set oSheet = Sheets.Add
oSheet.Activate
oSheet.Cells(1, 1).Select
Call CreateHeadLinesAndFormat
lRowCounter = 2
Call MWReadSubFolder(sRootPath)
Set oSheet = Nothing
End Sub
Private Sub CreateHeadLinesAndFormat()
Dim i As Long
oSheet.Cells(1, 1) = "Pfad"
oSheet.Cells(1, 2) = "Dateiname"
oSheet.Columns(1).ColumnWidth = 40
oSheet.Columns(2).ColumnWidth = 40
For i = 1 To 2
With oSheet
.Cells(1, i).Interior.ColorIndex = 11
.Cells(1, i).Font.Color = vbWhite
.Cells(1, i).Font.Bold = True
End With
Next i
End Sub
Private Sub MWReadSubFolder(ByVal sPath As String)
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
With oSheet
For Each oSubFolder In oFolder.SubFolders
'Alle Dateien auflisten
For Each oFile In oSubFolder.Files
.Cells(lRowCounter, 1) = oSubFolder.Path
.Cells(lRowCounter, 2) = oFile.Name
lRowCounter = lRowCounter + 1
Next oFile
'Alle Unterverzeichnisse verarbeiten (rekursiv)
Call MWReadSubFolder(oSubFolder.Path)
Next oSubFolder
End With
Set oFSO = Nothing
Set oFile = Nothing
Set oFolder = Nothing
Set oSubFolder = Nothing
End Sub
gönderdiginiz kodu calistirdim bu kod sadece en alt klasördeki dosyalari sildi digerleri malesef kaldi.
Ekte gönderdigim kod istedigim klasörü detayli olarak inceleyip listeliyor sizce bu koda nasil bir ekleme yaparsak belirttigimiz dosya tipleri siler ?
Option Explicit
Option Compare Text
Const sRootPath As String = "C:\Users\ersano\Desktop\New folder (3)" 'Pfad bitte anpassen ohne Trennzeichen am Ende!!!
Private lRowCounter As Long
Private oSheet As Object
'Start der Routine: Call MWDateienMitUnterordnernAuslesen
Public Sub MWDateienMitUnterordnernAuslesen()
Set oSheet = Sheets.Add
oSheet.Activate
oSheet.Cells(1, 1).Select
Call CreateHeadLinesAndFormat
lRowCounter = 2
Call MWReadSubFolder(sRootPath)
Set oSheet = Nothing
End Sub
Private Sub CreateHeadLinesAndFormat()
Dim i As Long
oSheet.Cells(1, 1) = "Pfad"
oSheet.Cells(1, 2) = "Dateiname"
oSheet.Columns(1).ColumnWidth = 40
oSheet.Columns(2).ColumnWidth = 40
For i = 1 To 2
With oSheet
.Cells(1, i).Interior.ColorIndex = 11
.Cells(1, i).Font.Color = vbWhite
.Cells(1, i).Font.Bold = True
End With
Next i
End Sub
Private Sub MWReadSubFolder(ByVal sPath As String)
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
With oSheet
For Each oSubFolder In oFolder.SubFolders
'Alle Dateien auflisten
For Each oFile In oSubFolder.Files
.Cells(lRowCounter, 1) = oSubFolder.Path
.Cells(lRowCounter, 2) = oFile.Name
lRowCounter = lRowCounter + 1
Next oFile
'Alle Unterverzeichnisse verarbeiten (rekursiv)
Call MWReadSubFolder(oSubFolder.Path)
Next oSubFolder
End With
Set oFSO = Nothing
Set oFile = Nothing
Set oFolder = Nothing
Set oSubFolder = Nothing
End Sub
bir önceki mesajımdaki kodu (10.Mesaj) güncelledim deneyin.
Kendi kodunuzu uyarladım, Test ettiğimde çalışıyor. Sonuç olumsuz demek anlaşılır bir sonuç değil.
Sorunuzun çözümü için konuyu gören UZMAN ARKDAŞLAR yardımcı olurlar.
- Durum