Steuerung

Question

Hallo Miteinander,

ich stehe grad vor dem Schlauch mit der Bitte um Hilfe.
mit dem Folgendem Modul lese ich 3 Unterordner aus mit einem Matrix Initialisiere ich die Ordnernamen. Nach dem ersten Ordner lasse ich die Anzahl der xlsx. Dat ermitteln.( siehe '//Info )
nun möchte das alle ermittelten xlsx. dat Einzel geöffnet wird in der Mappe jede einzelne Sheet. als Datei in Ausgabepfad gespeichert wird. Wenn die Mappe Bearbeitet worden ist soll die nächste gefundene Datei geöffnet werden.

Wenn der Ordner (Beispiel V ) fertig bearbeitet worden ist soll nun der Ordner P untersucht werden usw.

Könn Ihr mir Helfen.

Gruss,



Option Explicit

Public Sub Steuerung()

'//deklarationen
Dim DateiName, i, a, Ausgabepfad, Dateipfad, DateiNamen As String
Dim objWorkbook As Workbook
Dim wks As Worksheet
Dim OrdnerMatrix As Variant
Dim z, Anzahl As Integer

'//Errorhandler initialisieren
On Error GoTo err_exit

Ausgabepfad = (ThisWorkbook.Path & "\" & "Output")

'//matrix initialisieren
OrdnerMatrix = Array("V", "P", "Z")

For i = 0 To 2
'//Datei und Ordnerangaben
Dateipfad = ThisWorkbook.Path & "\" & OrdnerMatrix(z) & "\"
DateiName = Dir(Dateipfad & "\*.xlsx*")

'//Anzahl der Dateien Ermitteln
DateiNamen = Dir(Dateipfad & "*.xlsx*")
Do While DateiNamen <> ""
DateiNamen = Dir
Anzahl = Anzahl + 1
Loop
Exit Sub

'//Excelmappen öffnen
For a = 0 To Anzahl
Set objWorkbook = Workbooks.Open(Dateipfad & DateiName)
Do
'//Tabbellen Kopieren und speichern
For Each wks In ThisWorkbook.Worksheets
ThisWorkbook.Worksheets(wks.Name).Copy
ActiveWorkbook.SaveAs Ausgabepfad & "\" & wks.Name
objWorkbook.Close SaveChanges:=False

Next wks

'//wird keine Mappe mehr gefunde Schleife verlassen
Loop Until DateiName = ""


Exit Sub

err_exit:
MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Fehlermeldung"

End Sub

Answer 1

ich mache bei der Durcharbeit der 3 Schleife einen Fehler
nur wo?
Vielen Dank für eure Hilfe


Gruss, NOSPE

Answer 2

Hallo,

was mir beim drüberlesen auffällt: Wo ist die Schleife, die z definiert?

Der Code-Teil

Dateipfad = ThisWorkbook.Path & "\" & OrdnerMatrix(z) & "\"

bringt ja immer "V" (=Nummer 0 deiner Ordner-Matrix). Du greifst also nur auf diesen Unterordner zu.

Gruß

M.O.

Answer 3

hi all ^^

ungetestet,probier mal ^^

gruss nighty

Sub NOSPE()
Dim DateiName As String
Dim Oauswahl As Variant
Dim WksIndex As Integer
For Each Oauswahl In Array("V", "P", "Z")
DateiName = Dir(ThisWorkbook.Path & Oauswahl & "*.xlsx")
Do While DateiName <> ""
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Oauswahl & "\"
For WksIndex = 1 To Worksheets.Count
ThisWorkbook.Worksheets(WksIndex).Name.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Output" & "\" & ThisWorkbook.Worksheets(WksIndex).Name
Next WksIndex
Workbooks(DateiName).Close SaveChanges:=True
DateiName = Dir
Loop
Next Oauswahl
End Sub

Answer 4

hi all ^^

schon korrigiert hmm

gruss nighty

Sub NOSPE()
Dim DateiName As String
Dim Oauswahl As Variant
Dim WksIndex As Integer
For Each Oauswahl In Array("V", "P", "Z")
DateiName = Dir(ThisWorkbook.Path & Oauswahl & "*.xlsx")
Do While DateiName <> ""
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Oauswahl & "\" & DateiName
For WksIndex = 1 To Worksheets.Count
ThisWorkbook.Worksheets(WksIndex).Name.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Output" & "\" & ThisWorkbook.Worksheets(WksIndex).Name
Next WksIndex
Workbooks(DateiName).Close SaveChanges:=True
DateiName = Dir
Loop
Next Oauswahl
End Sub

Answer 5

Hallo zusammen,

danke dir nighty und M.O

vielen lieben dank