Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 10:59:29
Datei Auswählen und öffnen
19.04.2024 10:46:47
Bestimmte Zellen aus dynamischer Liste zurückgeben
19.04.2024 10:39:36
Schaltfläche auf einem Tabellenblatt NICHT mit abspeichern
19.04.2024 09:26:26
Median für Zeilen mit gleichen Zeitstempel
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1636to1640
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1636to1640
1636to1640
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Ausgabe array

Ausgabe array
03.08.2018 15:18:26
Cord
Hallo muss mal wieder fragen
ich habe einen array erstellt und möchte jetzt zum Testen, ob da das richtigen gespeichert ist. Das würde ich über ein Ausgabefenster machen bekomme das aber nicht hin. Alles was ich gefunden habe geht leider nicht.
'Public Verzeichnis() As String
Sub ErstelleVerzeichnisArray(Pfad As String) 'Liste der PIC Ordner
ReDim Verzeichnis(0) As String
Verzeichnis(0) = Pfad
Call DirArray(Pfad)
End Sub 
Private Sub DirArray(strRoot As String)
Dim strVerzeichnisname As String
Dim lngAnzahlVerzeichnis As Long
Dim lngStart As Long, i As Long
Set rootFolder = fileExcel.ParentFolder
'   If Right(strRoot, 1)  "\" Then strRoot = strRoot & "\"
lngAnzahlVerzeichnis = UBound(Verzeichnis)
lngStart = lngAnzahlVerzeichnis
strVerzeichnisname = Dir(rootFolder & "Pictur*", vbDirectory)
Do While Len(strVerzeichnisname)
If Left(strVerzeichnisname, 1)  "." Then
If GetAttr(strRoot & strVerzeichnisname) And vbDirectory Then
lngAnzahlVerzeichnis = lngAnzahlVerzeichnis + 1
ReDim Preserve Verzeichnis(lngAnzahlVerzeichnis) As String
Verzeichnis(lngAnzahlVerzeichnis) = strRoot & strVerzeichnisname
End If
End If
strVerzeichnisname = Dir()
Loop
If lngStart
nach diesem Sub sollen die gefundenen Ordner gelöscht werden aber jetzt erst zum testen anzeigen
Cord

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ausgabe array
03.08.2018 15:28:38
Nepumuk
Hallo,
lass dir die Pfade im Direktbereich anzeigen:
Dim lngIndex As Long
For lngIndex = LBound(Verzeichnis) To UBound(Verzeichnis)
    Debug.Print Verzeichnis(lngIndex)
Next

Gruß
Nepumuk
Anzeige
AW: Ausgabe array
06.08.2018 14:39:52
Cord
Leider bekomme ich keine Ausgabe
Löschen der Pic Ordner
Call Kill_Files
GoTo noerr
Public Verzeichnis() As String
Sub ErstelleVerzeichnisArray(Pfad As String) 'Liste der PIC Ordner
ReDim Verzeichnis(0) As String
Verzeichnis(0) = Pfad
Call DirArray(Pfad)
End Sub 
Private Sub DirArray(strRoot As String)
Dim strVerzeichnisname As String
Dim lngAnzahlVerzeichnis As Long
Dim lngStart As Long, i As Long
Set rootFolder = fileExcel.ParentFolder
If Right(strRoot, 1)  "\" Then strRoot = strRoot & "\"
lngAnzahlVerzeichnis = UBound(Verzeichnis)
lngStart = lngAnzahlVerzeichnis
strVerzeichnisname = Dir(rootFolder & "Pictur*", vbDirectory)
Do While Len(strVerzeichnisname)
If Left(strVerzeichnisname, 1)  "." Then
If GetAttr(strRoot & strVerzeichnisname) And vbDirectory Then
lngAnzahlVerzeichnis = lngAnzahlVerzeichnis + 1
ReDim Preserve Verzeichnis(lngAnzahlVerzeichnis) As String
Verzeichnis(lngAnzahlVerzeichnis) = strRoot & strVerzeichnisname
End If
End If
strVerzeichnisname = Dir()
Loop
If lngStart

Löschen der Pic Ordner 
Private Sub Kill_Files()
Dim intF As Integer
If pintFile > 0 Then
For intF = 1 To pintFile
Kill parrFile(intJ)
Next
Zeilen verschoben, da sonst immer "0 Worddokumente wurden gelöscht" angezeigt iwrd
MsgBox pintFile & " Ordner gelöscht", vbInformation + vbOKOnly, "Kill_File"
Erase parrFile
pintFile = 0
Else
MsgBox "Keine Worddokumente in Array gespeichert", vbInformation + vbOKOnly, " _
Kill_Files"
End If
End Sub

Option Explicit
Public PicOrdnerLoeschen()
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFolder ("C:\Temp\12")
Set objFSO = Nothing
End Sub Hier ist was ich habe und bitte die Könner um Mithilfe
Dieses soll in einen größeren Block eingefügt werden, der auch Word Dateien löscht bzw umwandelt
Mfg Cord
Anzeige
AW: Ausgabe array
06.08.2018 17:13:57
Nepumuk
Hallo,
beschreib mal was du genau vor hast, zusammen finden wir sicher eine Lösung.
Gruß
Nepumuk
AW: Ausgabe array
07.08.2018 08:25:12
Cord
Hallo Nepumuk
Ich möchte in einem Ordner der eine Ordnerstruktur enthält bestimmte Ordner (Picture)
heraussuchen und mit Inhalt löschen.
Leider sind die nicht alle exakt gleich benannt (Picture/Pictures) daher die Wildcard am Ende der Namens.
Diese Ordner sind in mehreren Unterordnern verteilt.
Das wollte ich über einen Array lösen ( wird schon für Word Dateien benutzt)
aber ich bekomme keine Ausgabe und keine Fehlermeldung.
Leider habe ich nicht die Zeit mich mit VBA so zu beschäftigen wie ich müsste um das zu lernen.
Cord
Anzeige
AW: Ausgabe array
07.08.2018 08:26:34
Cord
Immer vergesse ich den Haken :)
AW: Ausgabe array
07.08.2018 13:11:06
Nepumuk
Hallo,
teste mal:
Option Explicit

Public Sub DeletePictureFolders()
    Const FOLDER_PATH As String = "H:\Beispiel\" 'anpassen !!!
    Dim astrFolders() As String
    Dim ialngIndex As Long
    Dim objFileSystem As Object
    astrFolders = GetFolders(FOLDER_PATH)
    Set objFileSystem = CreateObject(Class:="Scripting.FileSystemObject")
    On Error Resume Next
    For ialngIndex = LBound(astrFolders) To UBound(astrFolders)
        If astrFolders(ialngIndex) Like "*Picture*" Then _
            Call objFileSystem.DeleteFolder(Left$(astrFolders(ialngIndex), _
            Len(astrFolders(ialngIndex)) - 1), True)
    Next
    Set objFileSystem = Nothing
End Sub

Private Function GetFolders(ByVal pvstrPath As String) As String()
    Dim astrFolders() As String
    Dim strFolder As String, strPath As String
    Dim ialngIndex1 As Long, ialngIndex2 As Long
    strPath = pvstrPath
    Do
        strFolder = Dir$(strPath & "*", vbDirectory)
        Do Until strFolder = vbNullString
            If strFolder <> "." And strFolder <> ".." Then
                If GetAttr(strPath & strFolder) And vbDirectory Then
                    Redim Preserve astrFolders(0 To ialngIndex1)
                    astrFolders(ialngIndex1) = strPath & strFolder & "\"
                    ialngIndex1 = ialngIndex1 + 1
                End If
            End If
            strFolder = Dir$
        Loop
        If ialngIndex1 = ialngIndex2 Then Exit Do
        strPath = astrFolders(ialngIndex2)
        ialngIndex2 = ialngIndex2 + 1
    Loop
    GetFolders = astrFolders
End Function


Gruß
Nepumuk
Anzeige
AW: Ausgabe array
07.08.2018 16:06:23
Cord
Wow das funktioniert super.
Nur den root folder
Const FOLDER_PATH As String = "H:\Beispiel\" 'anpassen !!!
würde ich gerne mit dem Exel file verbinden
wie in diesem Beispiel
' Start-Ordner setzen für die in PDF umzuwandelnden Word-Dateien
Set rootFolder = fileExcel.ParentFolder
geht das auch noch ?
Weil das muss nicht nur für den einen Ordner sondern immer wieder für andere laufen.
Danke Cord
AW: Ausgabe array
07.08.2018 16:31:47
Nepumuk
Hallo Cord,
teste mal:
Public Sub DeletePictureFolders()
    Dim strFolderPath As String
    Dim astrFolders() As String
    Dim ialngIndex As Long
    strFolderPath = ThisWorkbook.Path & "\"
    Dim objFileSystem As Object
    astrFolders = GetFolders(strFolderPath)
    Set objFileSystem = CreateObject(Class:="Scripting.FileSystemObject")
    On Error Resume Next
    For ialngIndex = LBound(astrFolders) To UBound(astrFolders)
        If astrFolders(ialngIndex) Like "*Picture*" Then _
            Call objFileSystem.DeleteFolder(Left$(astrFolders(ialngIndex), _
            Len(astrFolders(ialngIndex)) - 1), True)
    Next
    Set objFileSystem = Nothing
End Sub

Gruß
Nepumuk
Anzeige
AW: Ausgabe array
08.08.2018 15:06:33
Cord
Super und herzlichen Dank an Nepumuk
Jetzt funktioniert alles zwar hat 
strFolderPath = ThisWorkbook.Path & "\"
nicht funktioniert aber
strFolderPath = ActiveWorkbook.path & "\"
dafür umso besser
warum ich hinter 

If astrFolders(ialngIndex) Like "*Picture*" Then _
Call objFileSystem.DeleteFolder(Left$(astrFolders(ialngIndex), _
Len(astrFolders(ialngIndex)) - 1), True)
kein Elseif setzen konnte ist mit nicht klar aber mit einer neuen If Schleife haben sich auch die falsch benannten "Bild" Ordner erledigt.
Versuche mit Like und OR auf die "Bild" Ordner zu prüfen war leider ohne Erfolg
Hier nochmal der jetzt funtionierende Code
Public Sub DeletePictureFolders()
Dim strFolderPath As String
Dim astrFolders() As String
Dim ialngIndex As Long
strFolderPath = ActiveWorkbook.path & "\"
Dim objFileSystem As Object
astrFolders = GetFolders(strFolderPath)
Set objFileSystem = CreateObject(Class:="Scripting.FileSystemObject")
On Error Resume Next
For ialngIndex = LBound(astrFolders) To UBound(astrFolders)
If astrFolders(ialngIndex) Like "*Picture*" Then _
Call objFileSystem.DeleteFolder(Left$(astrFolders(ialngIndex), _
Len(astrFolders(ialngIndex)) - 1), True)
If astrFolders(ialngIndex) Like "*Bild*" Then _
Call objFileSystem.DeleteFolder(Left$(astrFolders(ialngIndex), _
Len(astrFolders(ialngIndex)) - 1), True)
Next
Set objFileSystem = Nothing
End Sub
Private Function GetFolders(ByVal pvstrPath As String) As String()
Dim astrFolders() As String
Dim strFolder As String, strPath As String
Dim ialngIndex1 As Long, ialngIndex2 As Long
strPath = pvstrPath
Do
strFolder = Dir$(strPath & "*", vbDirectory)
Do Until strFolder = vbNullString
If strFolder  "." And strFolder  ".." Then
If GetAttr(strPath & strFolder) And vbDirectory Then
ReDim Preserve astrFolders(0 To ialngIndex1)
astrFolders(ialngIndex1) = strPath & strFolder & "\"
ialngIndex1 = ialngIndex1 + 1
End If
End If
strFolder = Dir$
Loop
If ialngIndex1 = ialngIndex2 Then Exit Do
strPath = astrFolders(ialngIndex2)
ialngIndex2 = ialngIndex2 + 1
Loop
GetFolders = astrFolders
End Function
Einzige Änderung die ich vorgenommen habe ist der Pfad und die zusätzliche IF Schleife
Rest ist wie von Nepumuk geschrieben
Nochmals vielen Dank
Cord
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige