Frage zu einem Makro zum wiederholten Öffnen, Bearbeiten, Speichern und Schliessen von Dateien

Question

Hallo, ich habe mich neu angemeldet, da ich hier schon desöfteren Lösungen gefunden habe, bei dem nachfolgend beschriebenen Problem aber nicht weiterkomme. Für Lösungsvorschläge schon im voraus vielen Dank!

Ich möchte mehrere Exceldateien, deren Namen variieren nacheinander öffnen, jeweils in der geöffneten Datei einige Befehle ablaufen lassen, die Datei in einem anderen Netzwerpfad speichern und die Datei wieder schließen. Dann soll die nächste Datei im gleichen Muster folgen, bis alle abgearbeitet sind. Im Ordner der zu bearbeitenden Dateien liegen weitere Dateien, die nicht bearbeitet werden sollen, es ist also eine Auswahl notwendig. Die Anzahl der zu bearbeitenden Dateien variiert.

Das folgende Makro habe ich schon erstellt und es funtioniert wenn ich eine einzelne Datei manuell öffne, dass Makro aufrufe und die Datei danach manuell schliesse:

Sub Format1()
'
' Format1 Makro
'

'
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 10
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With


ActiveWorkbook.SaveAs Filename:= _
"\\SERVER\Export\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Was fehlt ist die Auswahl, die Schleife damit die ausgewälten Dateien geöffnet, abgearbeitet und geschlossen werden bis alle ausgewählten Dateien abgearbeitet werden.

Danke für jede Hilfe auch in Teilbereichen

Answer 1

Hallo joe910,

nacjfolgendes Makro öffnet alle Exceldateien in einem bestimmten Verzeichnis und fürht Deinen Formatierungsstring durch.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Sub Alle_Exceldateien_formatieren()
Dim objFileSystemObject As Object
Dim objAnzDateien As Object
Dim objDatei As Object

Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set objAnzDateien = objFileSystemObject.getfolder("C:\Eigene Dateien\")

For Each objDatei In objAnzDateien.Files
If Right(objDatei.Name, 4) = ".xls" Then

With ActiveSheet.PageSetup
.PrintArea = ""
.PrintTitleRows = ""
.PrintTitleColumns = ""
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 10
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With

ActiveWorkbook.SaveAs Filename:= _
"\\SERVER\Export\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End If
Next

Set objFileSystemObject = Nothing
Set objAnzDateien = Nothing
End Sub

Du musst in dem Makro in der Zeile

[code]Set objAnzDateien = objFileSystemObject.getfolder("C:\Eigene Dateien\")

den Pfad noch anpassen, da bei Dir sicherlich ein anderer Pfad abgefragt werden soll.
Was nicht realisiert wurde ist die Aufgabenstellung

....damit die ausgewälten Dateien geöffnet, abgearbeitet und geschlossen werden bis alle ausgewählten Dateien abgearbeitet werden.

Wie werden/ sollen denn die Dateien ausgewählt werden?


MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 2

Hallo Oliver,

zunächst vielen Dank für die Antwort, ich komme erst heute am Nachmittag dazu Dein Makro zu testen., werde dann berichten.

Zur Frage: Am liebsten (eventuell etwas naiv) wie im Dialog Datei öffnen und dann Mehrfachauswahl mit der Umschalt- oder Strg Taste, je nach Bedarf. Realistischer wahrscheinlich mit so etwas wie einer Listbox. Wichtig ist nur, dass man es nur einmal anstossen muss, da z.T. 50+ Dateien zu verarbeiten sind.

Eingelesen werden übrigens xml Dateien, das hatte ich vergessen zu erwähnen. Aber da muss ich ja nur die Zeile

If Right(objDatei.Name, 4) = ".xls" Then

entsprechend anpassen und dabei das xls durch xml ersetzen.

Gruß, Johannes

Answer 3

Hallo joe910,

lade Dir mal unter
http://www.excelbeispiele.de/Beispiele_Supportnet/Beispiel_joe910.xls eine Beispieldatei herunter, die ich Dir erstellt habe. Darin wird eine ListBox mit Exceldateien gefüllt. Alle Dateien, die Du markierst, werden dann geöffnet. Du musst allerdings im Modul1 noch den Pfad in der Zeile

Const strPath As String = "H:\"
anpassen. Außerdem musst Du in der Zeile

If Right(objDatei.Name, 4) = ".xls" Then
die Endung anpassen.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 4

Hallo Oliver,

leider bin ich erst heute zum Testen gekommen, hier die Resultate:

zu Deiner ersten Antwort:
Ich habe die Pfade und die Endung angepasst. Wenn ich das Makro ausführe wird versucht die geöffnete Datei mehrfach im angegebenen Pfad zu speichern. Es erscheint dann die Meldung, dass die Datei in Zielordner schon vorhanden sei und ob sie überschreben werden soll. Die im unter

Set objAnzDateien = objFileSystemObject.getfolder("C:\Eigene Dateien\")

angebenen Pfad gespeicherten Dateien werden nicht geöffnet, so auch nicht nacheinander bearbeitet und im Zielordner gespeichert.

zu Deiner zweiten Antwort:
Ja, so eine Listbox ist gut nutzbar. Nachteil ist, dass dann wirklich alle 50+ Dateien auf einmal geöffnet werden. In jeder geöffneten kann ich dann natürlich das Makro anstossen, benötigt also Präsenz während der Bearbeitung. Schön wäre halt eine Schleife: Alle benötigten Dateien auswählen und dann wird die erste geöffnet, bearbeitet, gespeichert, geschlossen. Dann kommt die zweite dran. Das ganze so lange, bis alle ausgewählten Dateien abgearbeitet sind.

Gruß,
Johannes

Answer 5

Hallo Johannes,

das mit der Erweiterung aus meiner 1.Antwort beim Speichern gefragt wird, ist klar, da die eine Datei noch geöffnet ist.
Füge unter derm SaveAs-Befehl noch
Workbooks(Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & ".xls").Closeein. Damit wird die gerade gespeicherte Exceldatei geschlossen.

Das 2. was Du schreibst, wird doch so gemacht. Es werden alle Dateien, die Du markierst nacheinander geöffnet. ich habe in dem Code dafür nur niht den Close-Befehl eingebaut, damit jede Datei dann wieder geschlossen wird.
Lade Dir mal unter http://excelbeispiele.de/clicktracker/clicktracker.php?id=641
die neue Beispieldatei herunter. Dort wird jede Datei, die Du markierst geöffnet, der Wert aus ZelleA1 ausgelesen und in einer MessageBox angezeigt und danach wieder geschlossen. Anstelle des Aufrufens der MessageBox, musst Du dort den Code, der ausgeführt werden soll, einfügen.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]