Listboxta seçtiğim dosyaları bilgisayardan silmek

[ikikan]

Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40

Private Sub mksil_Click()
On Error Resume Next
Dim op As SHFILEOPSTRUCT
Unload msil
With op
.wFunc = FO_DELETE
.pFrom = "E:\PEGEM2008\YAPTIGIM PROGRAMLAR\PegemMT\KartP\" & msil.sdosya.Caption
.fFlags = FOF_ALLOWUNDO
End With
SHFileOperation op
ChDir "E:\PEGEM2008\YAPTIGIM PROGRAMLAR\PegemMT\KartP\"
ListBox1.Clear
dosya = Dir("*.*")
While dosya <> ""
ListBox1.AddItem dosya
dosya = Dir
Wend
ChDir "E:\PEGEM2008\YAPTIGIM PROGRAMLAR\PegemMT\KartP"
End Sub
Private Sub miptal_Click()
PGiris.Show
End Sub
Private Sub sdosya_Click()

End Sub
Private Sub UserForm_Initialize()
msil.sdosya.Caption = ""
msil.sdosya.Caption = ListBox1.Value
End Sub


neden hata veriyor ?

dosya ekte incelerseniz

 

[halit3]

[quote
neden hata veriyor ?

dosya ekte incelerseniz[/quote]

Pgiriş formunda CommandButton2_Click kodunu aşağıdaki ile değiştirin.

Private Sub CommandButton2_Click()
a = MsgBox("Kişi kartını silmek istiyormusunuz. ?", vbYesNo + vbInformation, " Silme penceresi")
If a = vbYes Then
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
DosyaSistemi.DeleteFile "E:\PEGEM2008\YAPTIGIM PROGRAMLAR\PegemMT\KartP\" & ListBox1.Value 'burada uzantısı yoksa eklenecek
End If
End Sub

 

[ikikan]

[quote
neden hata veriyor ?

dosya ekte incelerseniz

Pgiriş formunda CommandButton2_Click kodunu aşağıdaki ile değiştirin.

Private Sub CommandButton2_Click()
a = MsgBox("Kişi kartını silmek istiyormusunuz. ?", vbYesNo + vbInformation, " Silme penceresi")
If a = vbYes Then
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
DosyaSistemi.DeleteFile "E:\PEGEM2008\YAPTIGIM PROGRAMLAR\PegemMT\KartP\" & ListBox1.Value 'burada uzantısı yoksa eklenecek
End If
End Sub

[/QUOTE]


halit3 bey bu makro işe yarıyor fakat listbox daki dosyaları siliyor fakat list box yenilenmiyor dosya silinse de listbox da gözüküyor
ayrıca kayıtlı olan ecxel sayfası acıken hata veriyor programı durduruyor .. bunlar ile ilgili kod varsa yardım ederseniz sevinirim

 

[halit3]

Kod

Private Sub CommandButton2_Click()
a = MsgBox("Kişi kartını silmek istiyormusunuz. ?", vbYesNo + vbInformation, " Silme penceresi")
If a = vbYes Then
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Dim wkbk As Workbook
For Each wkbk In Application.Workbooks
If wkbk.Name <> ActiveWorkbook.Name Then
If wkbk.Name = ListBox1.Value Then
wkbk.Close
End If
End If
Next
DosyaSistemi.DeleteFile "E:\PEGEM2008\YAPTIGIM PROGRAMLAR\PegemMT\KartP\" & ListBox1.Value 'burada uzantısı yoksa eklenecek
ListBox1.RemoveItem ListBox1.ListIndex
End If
End Sub