Makros in mehreren Dateien ausführen

Forumthread: Makros in mehreren Dateien ausführen

02.02.2009 21:47:19

Thordsen-Sörensen

Hallo zusammen,
ich tüffelt seit einigen Stunden an folgender Situation und finde einfach keine Lösung:
Ich habe in einer Excel-Datei (nenne sie mal Masterdatei) fünf verschiedene Makros programmiert (z.B. das Löschen von Zeilen) die auf verschiedene Dateien (nenne sie mal Unterdatein) mit gleicher Datenaufbereitung angewendet werden sollen. Die Masterdatei und die Unterdateien befinden sich in verschiedenen Ordnern.
Mein Ansatz war folgender: Die Masterdatei soll den Ordner mit den Unterdateien ansprechen und alle Unterdateien nach und nach mit den fünf Makros bearbeiten. Umsetzung halt über eine entsprechende Schleife.
Kann mir einer von Euch bei der Programmierung weiterhelfen. Habe einfach die Schwierigkeiten:
- den richtigen Pfad in dem Code zu hinterlegen und
- bekomme in der Schleife einfach immer Laufzeitfehler angezeigt.
Hoffe ich konnte mein Vorhaben vernünftig darstellen.
Vielen Dank.
Gruß Ulf

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makros in mehreren Dateien ausführen

02.02.2009 21:49:13

Josef

Hallo Ulf,
dazu muss man schon deine Makros kennen, sonst wird das ein ewiges Ratespiel.

Gruß Sepp

AW: Makros in mehreren Dateien ausführen

02.02.2009 22:01:37

Thordsen-Sörensen

Hi,
danke für die schnelle Antwort. Kann gerade nicht auf die Datein zugreifen, sind leider auf einem anderen Rechner. Melde mich morgen diesbezüglich nochmal.
Danke!

AW: Makros in mehreren Dateien ausführen

03.02.2009 08:56:48

Ulf

Guten Morgen,
anbei die von mir bisher gestaltete Masterdatei, die die eingebundenen Makros in den Exceldateinen eines anderen Ordners ausführen sollen.
Denke der Zugriff auf den anderen Ordner ist noch nicht korrekt, also nicht vorhanden. Makro dürfte bisher nur auf den Ordner zugreifen, in dem sich die Masterdatei selbstbefindet. Und der Aufruf der Call Anweisung funktioniert ebenso nicht.


Sub AnwendungMakrosVerzeichnis()
Dim Verz As Folder  'Verzeichniss-Objekt anlegen
Dim Datei As File   'Datei-Objekt anlegen
Dim wb As Workbook
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
'Das Verzeichniss-Objekt mit dem Verzeichniss
'der geöffneten Datei zuweisen:
Set Verz = fso.GetFolder(ActiveWorkbook.Path)
'Nun alle Dateien in dem Ordner durchgehen
For Each Datei In Verz.Files
'Wenn es eine Excel Datei ist
If UCase(Right(Datei.Name, 3)) = "XLS" Then
'Wenn die Datei noch nicht geoeffnet ist oeffnen
If Not WorkbookIsOpen(Datei.Name) Then
If Right(Datei.Path, 1) = "\" Then
Workbooks.Open Datei.Path
Else
Workbooks.Open Datei.Path
End If
End If
'Die Datei zuweisen und aktivieren
Set wb = Workbooks(Datei.Name)
wb.Activate
'hier nun dein Makro aufrufen
Call ZeilenLöschen
Call SpalteLöschen
Call SpaltenLöschen
Call SpaltenLöschen1
Call TabellenblattLöschen
Call TabellenblattLöschen1
'eventuell die Datei speichern und schliessen
wb.Save
wb.Close
End If
Next
End Sub

'Pruefung ob die Datei schon in Excel geoeffnet ist


Function WorkbookIsOpen( _
ByVal WorkbName As String _
) As Boolean
Dim wb As Workbook
For Each wb In Workbooks
If wb.Name = WorkbName Then
WorkbookIsOpen = True
Exit Function
End If
Next
WorkbookIsOpen = False
End Function


Sub ZeilenLöschen()
Sheets("Close").Activate
Rows("2:18").Select
Selection.Delete Shift:=xlUp
End Sub


Sub SpalteLöschen()
Sheets("Close").Activate
Range("E1").Select
ActiveCell.EntireColumn.Delete
End Sub


Sub SpaltenLöschen()
Sheets("Close").Activate
Columns("F:P").Select
Selection.Delete Shift:=xlToLeft
End Sub


Sub SpaltenLöschen1()
Sheets("Close").Activate
Columns("G:K").Select
Selection.Delete Shift:=xlToLeft
End Sub


Sub TabellenblattLöschen()
Application.DisplayAlerts = False
Sheets(2).Delete
End Sub


Sub TabellenblattLöschen1()
Application.DisplayAlerts = False
Sheets(2).Delete
End Sub

Hoffe ich habe alle wichtigen Infos angegeben. Falls ein Pfad hinterlegt werden muss, kann einfach ein Beispielpfad integriert werden, änder den dann ab.
Vielen Dank!

AW: Makros in mehreren Dateien ausführen

03.02.2009 12:26:00

Josef

Hallo Ulf,
ÜProbier mal, ich habe die Umgebung jetzt nicht nachgebaut.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub AnwendungMakrosVerzeichnis()
    Dim strInitialPath As String, strpath As String
    Dim objWB As Workbook
    Dim objFSO As Object
    Dim objFSODirectory As Object 'Verzeichniss-Objekt anlegen
    Dim objFSOFile As Object 'Datei-Objekt anlegen

    On Error GoTo ErrExit
    GMS

    strInitialPath = "C:\" 'Root-Verzeichnis zur Verzeichnisauswahl

    strpath = fncBrowseForFolder(strInitialPath)

    If strpath = "" Then GoTo ErrExit

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Das Verzeichniss-Objekt mit dem Verzeichniss
    'der geöffneten objFSOFile zuweisen:

    Set objFSODirectory = objFSO.GetFolder(strpath)

    'Nun alle Dateien in dem Ordner durchgehen
    For Each objFSOFile In objFSODirectory.Files

        'Wenn es eine Excel objFSOFile ist
        If UCase(Right(objFSOFile.Name, 3)) = "XLS" Then

            'Wenn die objFSOFile noch nicht geoeffnet ist oeffnen
            If Not WorkbookIsOpen(objFSOFile.Name) Then
                Set objWB = Workbooks.Open(objFSOFile.Path)
            Else
                Set objWB = Workbooks(objFSOFile.Name)
            End If

            objWB.Activate

            'hier nun dein Makro aufrufen
            Call ZeilenLöschen
            Call SpalteLöschen
            Call SpaltenLöschen
            Call SpaltenLöschen1
            Call TabellenblattLöschen
            Call TabellenblattLöschen1
            'eventuell die objFSOFile speichern und schliessen
            objWB.Close True
            Set objWB = Nothing
        End If

    Next
    ErrExit:
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & vbLf & _
        "Beschreibung: " & Err.Description, vbExclamation, "Fehler"

    GMS True
    Set objFSO = Nothing
    Set objFSOFile = Nothing
    Set objFSODirectory = Nothing
    Set objWB = Nothing
End Sub

Private Function fncBrowseForFolder(Optional ByVal defaultPath = "") As String
    Dim objFlderItem As Object, objShell As Object, objFlder As Object

    Set objShell = CreateObject("Shell.Application")
    Set objFlder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, defaultPath)

    If objFlder Is Nothing Then GoTo ErrExit

    Set objFlderItem = objFlder.Self
    fncBrowseForFolder = objFlderItem.Path

    ErrExit:

    Set objShell = Nothing
    Set objFlder = Nothing
    Set objFlderItem = Nothing
End Function

'Pruefung ob die objFSOFile schon in Excel geoeffnet ist

Function WorkbookIsOpen( _
        ByVal WorkbName As String _
        ) As Boolean

    Dim objWB As Workbook

    For Each objWB In Workbooks
        If objWB.Name = WorkbName Then
            WorkbookIsOpen = True
            Exit Function
        End If
    Next

End Function

Private Sub GMS(Optional ByVal Modus As Boolean = False)
    Static lngCalc As Long

    With Application
        .ScreenUpdating = Modus
        .EnableEvents = Modus
        .DisplayAlerts = Modus
        .EnableCancelKey = IIf(Modus, 1, 0)
        If Not Modus Then lngCalc = .Calculation
        .Calculation = IIf(Modus, lngCalc, -4135)
        .Cursor = IIf(Modus, -4143, 2)
    End With

End Sub

Sub ZeilenLöschen()
    ActiveWorkbook.Sheets("Close").Rows("2:18").Delete Shift:=xlUp
End Sub

Sub SpalteLöschen()
    ActiveWorkbook.Sheets("Close").Range("E1").EntireColumn.Delete
End Sub

Sub SpaltenLöschen()
    ActiveWorkbook.Sheets("Close").Columns("F:P").Delete Shift:=xlToLeft
End Sub

Sub SpaltenLöschen1()
    ActiveWorkbook.Sheets("Close").Columns("G:K").Delete Shift:=xlToLeft
End Sub

Sub TabellenblattLöschen()
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets(2).Delete
    Application.DisplayAlerts = True
End Sub

Sub TabellenblattLöschen1()
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets(2).Delete
    Application.DisplayAlerts = True
End Sub

Gruß Sepp

AW: Makros in mehreren Dateien ausführen

03.02.2009 14:04:00

Ulf

Hallo nochmal,
es brauch sicher kleiner mher der Lösung meines Problems beschäftigen, habe ein Lösung gefunden.
Danke Ulf

Beliebteste Forumthreads (12 Monate)

Makros in mehreren Dateien ausführen

Forumthread: Makros in mehreren Dateien ausführen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Makros in mehreren Dateien ausführen

Forumthread: Makros in mehreren Dateien ausführen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread