Cep telefonundan dosya silmek

[Jeeday]

Merhabalar,

Elimde hazırladığım bir vba excel dosyası var. Bu dosyada android telefonun istediğim klasöründe bulunan dosyaları listeliyor.

Sonrasında herhangi bir dosyayı silmek istiyorum, ancak kodu modifiye edemedim.

Ayrıca bu listelenen dosyaların boyutlarını da yanındaki sütuna çekmek istiyorum.

Yardımlarınızı rica ederim.

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
Sub SYNC()
Dim S0 As Worksheet
Dim ThisComp, RootFold, Item, xFile, myFolder
Dim i, j, k As Integer
Dim oFSO, oFolder, oFile, AWF As Object

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set AWF = Application.WorksheetFunction
Set S0 = Sheets("TELEFON")
Set ThisComp = CreateObject("Shell.Application").Namespace("Shell:::{20D04FE0-3AEA-1069-A2D8-08002B30309D}")

For Each Item In ThisComp.Items
If InStr(LCase(Item.Path), "{6ac27878-a6fa-4155-ba85-f98f491d4f33}") Then
Set RootFold = Item.GetFolder
Exit For
End If
Next
S0.[B:F] = Empty
1
For i = 1 To S0.[A100].End(3).Row
2
S0.[C] = Empty
If IsObject(RootFold) Then
Set myFolder = RootFold.ParseName("Dahili depolama\ALPER\" & S0.Cells(i, "A")).GetFolder
For Each xFile In RootFold.ParseName("Dahili depolama\ALPER\" & S0.Cells(i, "A")).GetFolder.Items
j = j + 1
S0.Cells(j, "C") = xFile.Name & ".mp3"
'dosyanın boyutu nedir? S0.CELLS(j,"G") = xfile.size
'dosya silmek için gerekli komut?
Next
Else
MsgBox "Phone not connected"
End If
S0.[C:C].Sort S0.[C1], xlAscending
S0.Cells(i, "E") = S0.[C1000000].End(3).Row

YOL = "Q:\DJ ALVEE\" & S0.Cells(i, "A")

Set oFolder = oFSO.GetFolder(YOL)
k = 1
For Each oFile In oFolder.Files
S0.Cells(k, "D") = oFile.Name
k = k + 1
Next oFile
S0.Cells(i, "F") = S0.[D1000000].End(3).Row

If S0.Cells(i, "E") > S0.Cells(i, "F") Then
For j = 1 To S0.[C1000000].End(3).Row
Set ARA = S0.[D].Find(S0.Cells(j, "C"))
If ARA Is Nothing Then
MsgBox S0.Cells(i, "A") & S0.Cells(j, "C")
End If
Next j
GoTo 2
End If

For j = 1 To S0.[D1000000].End(3).Row
Set ARA = S0.[C:C].Find(S0.Cells(j, "D"))
If Not ARA Is Nothing Then
S0.Cells(j, "D") = Empty
End If
Next j
S0.[D].Sort S0.[D1], xlAscending
S0.Cells(i, "B") = AWF.CountA(S0.[D])
If S0.[D1] <> "" Then
For j = 1 To S0.[D1000000].End(3).Row
Dosya = YOL & S0.Cells(j, "D")
myFolder.CopyHere Dosya
'Sleep 10000
Next j
End If
j = Empty
Next i
If AWF.Sum(S0.[B:B]) <> 0 Then GoTo 1
S0.[B] = Empty
End Sub

 

[pitchoute]

Merhaba, dosya boyutunu almak için;

Function FormatFileSize(Bytes As Double) As String
    Dim Size As String
    If Bytes >= 1073741824 Then
        Size = Format(Bytes / 1073741824, "#0.00") & " GB"
    ElseIf Bytes >= 1048576 Then
        Size = Format(Bytes / 1048576, "#0.00") & " MB"
    ElseIf Bytes >= 1024 Then
        Size = Format(Bytes / 1024, "#0.00") & " KB"
    Else
        Size = Bytes & " Bytes"
    End If
    FormatFileSize = Size
End Function

Dim FileSizeBytes As Double
FileSizeBytes = xFile.ExtendedProperty("Size")
S0.Cells(j, "G") = FormatFileSize(FileSizeBytes)

Dosya silmek için;

xFile.InvokeVerb ("delete")

Belirli bir dosyayı silmek için;

For Each xFile In RootFold.ParseName("Dahili depolama\ALPER\" & S0.Cells(i, "A")).GetFolder.Items
    If xFile.Name = "silinecek_dosya.mp3" Then
        xFile.InvokeVerb ("delete")
    End If
Next

 

[Jeeday]

süper...

Peki xfile'ı "RootFold.ParseName("Dahili depolama\ALPER\" & S0.Cells(i, "A")).GetFolder.Items" klasöründeki xxx.mp3 dosyasıdır diye nasıl ayarlayabiliriz?

Set xfile = klasör/dosya.mp3 gibi yani....

 

[pitchoute]

Şöyle deneyebilirsiniz;

Set xFile = RootFold.ParseName("Dahili depolama\ALPER\" & S0.Cells(i, "A") & "\silinecek_dosya.mp3")

Örnek kullanım;

Set xFile = RootFold.ParseName("Dahili depolama\ALPER\" & S0.Cells(i, "A") & "\silinecek_dosya.mp3")
If Not xFile Is Nothing Then
    xFile.InvokeVerb ("delete")
Else
    MsgBox "Dosya bulunamadı."
End If