Gå til innhold

Program til fjerning av tomme mapper [Løst!]

Jogi

Av Jogi
i Programvare

Anbefalte innlegg

Jogi

Jogi

Skrevet
Skrevet (endret)

Hei lurte på om det finnes ett program som finner tomme mapper slik at man kan slette dem? :):D

Endret av Jogi

Videoannonse

Videoannonse
Annonse
backup

backup

Skrevet
Skrevet

Her er et vbs-script som sletter alle submapper innen en mappe du velger selv. Lagre det med filetternavnet vbs som for eksempel sletteTommeMapper.vbs, dobbelklikk script-ikonet, du får opp en dialogboks der du velger mappen der alle tomme submapper skal slettes (inklussive tomme mapper inni tomme mapper etc.), og jobben er gjort.

 

Dim arrFolders(), vFolder

intSize = 0 : strComputer = "."

On Error Resume next

Set cCommand = CreateObject("Scripting.FileSystemObject")

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set oShell = CreateObject("Shell.Application")

c = "Velg mappen der alle tomme submapper skal slettes:"

Set Path = oShell.BrowseForFolder (0,c,0,0)

Set folderPath= Path.Items.Item

strFolderName = folderPath.path

Set colSubfolders = objWMIService.ExecQuery _

("Associators of {Win32_Directory.Name='" _

& strFolderName & "'} " & "Where AssocClass = Win32_Subdirectory " _

& "ResultRole = PartComponent")

ReDim Preserve arrFolders(intSize)

arrFolders(intSize) = strFolderName

intSize = intSize + 1

For Each objFolder in colSubfolders

GetSubFolders strFolderName

Next

Sub GetSubFolders(strFolderName)

Set colSubfolders2 = objWMIService.ExecQuery _

("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _

& "Where AssocClass = Win32_Subdirectory " & "ResultRole = PartComponent")

For Each objFolder2 in colSubfolders2

strFolderName = objFolder2.Name

ReDim Preserve arrFolders(intSize)

arrFolders(intSize) = strFolderName

intSize = intSize + 1

GetSubFolders strFolderName

Next : End Sub

For i = Ubound(arrFolders) to 0 Step -1

strFolder = arrFolders(i)

set vFolder = CCommand.GetFolder(strFolder)

If ((vFolder.Files.Count = 0) And (vFolder.SubFolders.Count = 0)) Then

vFolder.Delete

End If : Next : MsgBox("Ferdig!")

Jogi

Jogi

Skrevet
  • Forfatter
Skrevet
Her er et vbs-script som sletter alle submapper innen en mappe du velger selv. Lagre det med filetternavnet vbs som for eksempel sletteTommeMapper.vbs, dobbelklikk script-ikonet, du får opp en dialogboks der du velger mappen der alle tomme submapper skal slettes (inklussive tomme mapper inni tomme mapper etc.),  og jobben er gjort.

 

Dim arrFolders(), vFolder

intSize = 0 : strComputer = "."

On Error Resume next

Set cCommand = CreateObject("Scripting.FileSystemObject")

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set oShell = CreateObject("Shell.Application")

c = "Velg mappen der alle tomme submapper skal slettes:"

Set Path = oShell.BrowseForFolder  (0,c,0,0)

Set folderPath= Path.Items.Item

strFolderName = folderPath.path

Set colSubfolders = objWMIService.ExecQuery _

("Associators of {Win32_Directory.Name='" _

& strFolderName & "'} " & "Where AssocClass = Win32_Subdirectory " _

& "ResultRole = PartComponent")

ReDim Preserve arrFolders(intSize)

arrFolders(intSize) = strFolderName

intSize = intSize + 1

For Each objFolder in colSubfolders

    GetSubFolders strFolderName

Next

Sub GetSubFolders(strFolderName)

    Set colSubfolders2 = objWMIService.ExecQuery _

    ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _

    & "Where AssocClass = Win32_Subdirectory " & "ResultRole = PartComponent")

    For Each objFolder2 in colSubfolders2

        strFolderName = objFolder2.Name

        ReDim Preserve arrFolders(intSize)

        arrFolders(intSize) = strFolderName

        intSize = intSize + 1

        GetSubFolders strFolderName

    Next : End Sub

For i = Ubound(arrFolders) to 0 Step -1

    strFolder = arrFolders(i)

    set vFolder = CCommand.GetFolder(strFolder)

    If ((vFolder.Files.Count = 0) And (vFolder.SubFolders.Count = 0)) Then

  vFolder.Delete

End If : Next : MsgBox("Ferdig!")

7741351[/snapback]

 

Uff da...hørtes dessverre litt innviklet ut :hmm: Noen andre please? :blush:

killerboy85

killerboy85

Skrevet
Skrevet
Her er et vbs-script som sletter alle submapper innen en mappe du velger selv. Lagre det med filetternavnet vbs som for eksempel sletteTommeMapper.vbs, dobbelklikk script-ikonet, du får opp en dialogboks der du velger mappen der alle tomme submapper skal slettes (inklussive tomme mapper inni tomme mapper etc.),  og jobben er gjort.

 

Dim arrFolders(), vFolder

intSize = 0 : strComputer = "."

On Error Resume next

Set cCommand = CreateObject("Scripting.FileSystemObject")

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set oShell = CreateObject("Shell.Application")

c = "Velg mappen der alle tomme submapper skal slettes:"

Set Path = oShell.BrowseForFolder  (0,c,0,0)

Set folderPath= Path.Items.Item

strFolderName = folderPath.path

Set colSubfolders = objWMIService.ExecQuery _

("Associators of {Win32_Directory.Name='" _

& strFolderName & "'} " & "Where AssocClass = Win32_Subdirectory " _

& "ResultRole = PartComponent")

ReDim Preserve arrFolders(intSize)

arrFolders(intSize) = strFolderName

intSize = intSize + 1

For Each objFolder in colSubfolders

    GetSubFolders strFolderName

Next

Sub GetSubFolders(strFolderName)

    Set colSubfolders2 = objWMIService.ExecQuery _

    ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _

    & "Where AssocClass = Win32_Subdirectory " & "ResultRole = PartComponent")

    For Each objFolder2 in colSubfolders2

        strFolderName = objFolder2.Name

        ReDim Preserve arrFolders(intSize)

        arrFolders(intSize) = strFolderName

        intSize = intSize + 1

        GetSubFolders strFolderName

    Next : End Sub

For i = Ubound(arrFolders) to 0 Step -1

    strFolder = arrFolders(i)

    set vFolder = CCommand.GetFolder(strFolder)

    If ((vFolder.Files.Count = 0) And (vFolder.SubFolders.Count = 0)) Then

  vFolder.Delete

End If : Next : MsgBox("Ferdig!")

7741351[/snapback]

 

Uff da...hørtes dessverre litt innviklet ut :hmm: Noen andre please? :blush:

7744046[/snapback]

 

ehh, klipp ut og lim inn? ikke være enn det...

Jogi

Jogi

Skrevet
  • Forfatter
Skrevet
Her er et vbs-script som sletter alle submapper innen en mappe du velger selv. Lagre det med filetternavnet vbs som for eksempel sletteTommeMapper.vbs, dobbelklikk script-ikonet, du får opp en dialogboks der du velger mappen der alle tomme submapper skal slettes (inklussive tomme mapper inni tomme mapper etc.),  og jobben er gjort.

 

Dim arrFolders(), vFolder

intSize = 0 : strComputer = "."

On Error Resume next

Set cCommand = CreateObject("Scripting.FileSystemObject")

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set oShell = CreateObject("Shell.Application")

c = "Velg mappen der alle tomme submapper skal slettes:"

Set Path = oShell.BrowseForFolder  (0,c,0,0)

Set folderPath= Path.Items.Item

strFolderName = folderPath.path

Set colSubfolders = objWMIService.ExecQuery _

("Associators of {Win32_Directory.Name='" _

& strFolderName & "'} " & "Where AssocClass = Win32_Subdirectory " _

& "ResultRole = PartComponent")

ReDim Preserve arrFolders(intSize)

arrFolders(intSize) = strFolderName

intSize = intSize + 1

For Each objFolder in colSubfolders

    GetSubFolders strFolderName

Next

Sub GetSubFolders(strFolderName)

    Set colSubfolders2 = objWMIService.ExecQuery _

    ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _

    & "Where AssocClass = Win32_Subdirectory " & "ResultRole = PartComponent")

    For Each objFolder2 in colSubfolders2

        strFolderName = objFolder2.Name

        ReDim Preserve arrFolders(intSize)

        arrFolders(intSize) = strFolderName

        intSize = intSize + 1

        GetSubFolders strFolderName

    Next : End Sub

For i = Ubound(arrFolders) to 0 Step -1

    strFolder = arrFolders(i)

    set vFolder = CCommand.GetFolder(strFolder)

    If ((vFolder.Files.Count = 0) And (vFolder.SubFolders.Count = 0)) Then

  vFolder.Delete

End If : Next : MsgBox("Ferdig!")

7741351[/snapback]

 

Uff da...hørtes dessverre litt innviklet ut :hmm: Noen andre please? :blush:

7744046[/snapback]

 

ehh, klipp ut og lim inn? ikke være enn det...

7744328[/snapback]

 

ehh lime inn hvor? Ganske grønn på script desverre :blush: Kan jeg da bruke dette programmet i f.eks Programfiler mappen? Finner den alle tomme undermapper i Programfiler mappen da?

killerboy85

killerboy85

Skrevet
Skrevet
ehh lime inn hvor? Ganske grønn på script desverre :blush:  Kan jeg da bruke dette programmet i f.eks Programfiler mappen? Finner den alle tomme undermapper i Programfiler mappen da?

7744421[/snapback]

 

altså du åpner notepad eller notisblokk og limer inn der med "ctrl" og "v"

lagrer fila som xxxx.vbs. jepp den funker har testet den ut selv.

Jogi

Jogi

Skrevet
  • Forfatter
Skrevet
ehh lime inn hvor? Ganske grønn på script desverre :blush:  Kan jeg da bruke dette programmet i f.eks Programfiler mappen? Finner den alle tomme undermapper i Programfiler mappen da?

7744421[/snapback]

 

altså du åpner notepad eller notisblokk og limer inn der med "ctrl" og "v"

lagrer fila som xxxx.vbs. jepp den funker har testet den ut selv.

7744549[/snapback]

 

Åkei kommer det ett icon opp eller bare gjør programmet jobben sin etter kjøring? Er det noe risk med å bruke programmet ettersom jeg ikke vet helt hva slags tomme mapper det er?

Jogi

Jogi

Skrevet
  • Forfatter
Skrevet
ehh lime inn hvor? Ganske grønn på script desverre :blush:  Kan jeg da bruke dette programmet i f.eks Programfiler mappen? Finner den alle tomme undermapper i Programfiler mappen da?

7744421[/snapback]

 

altså du åpner notepad eller notisblokk og limer inn der med "ctrl" og "v"

lagrer fila som xxxx.vbs. jepp den funker har testet den ut selv.

7744549[/snapback]

 

Åkei kommer det ett icon opp eller bare gjør programmet jobben sin etter kjøring? Er det noe risk med å bruke programmet ettersom jeg ikke vet helt hva slags tomme mapper det er?

7744636[/snapback]

 

Kommer visst ett icon ja står det :blush: Jeg prøver jeg :thumbup:

Jogi

Jogi

Skrevet
  • Forfatter
Skrevet
ehh lime inn hvor? Ganske grønn på script desverre :blush:  Kan jeg da bruke dette programmet i f.eks Programfiler mappen? Finner den alle tomme undermapper i Programfiler mappen da?

7744421[/snapback]

 

altså du åpner notepad eller notisblokk og limer inn der med "ctrl" og "v"

lagrer fila som xxxx.vbs. jepp den funker har testet den ut selv.

7744549[/snapback]

 

Åkei kommer det ett icon opp eller bare gjør programmet jobben sin etter kjøring? Er det noe risk med å bruke programmet ettersom jeg ikke vet helt hva slags tomme mapper det er?

7744636[/snapback]

 

Kommer visst ett icon ja står det :blush: Jeg prøver jeg :thumbup:

Suverene greier!! Funker som f... Tuuseen takk for hjelpen :thumbup:

7744678[/snapback]

Opprett en konto eller logg inn for å kommentere

Du må være et medlem for å kunne skrive en kommentar

Opprett konto

Det er enkelt å melde seg inn for å starte en ny konto!

Start en konto

Logg inn

Har du allerede en konto? Logg inn her.

Logg inn nå
Gå til emneliste

  • Hvem er aktive   0 medlemmer

    • Ingen innloggede medlemmer aktive
×
×
  • Opprett ny...