Excel-Dateien bearbeiten
21.03.2016 09:34:15
Marcel
ich möchte mehrere Excel-Dateien bearbeiten über ein Makro.
Am Freitag hat noch alles funktioniert, heute komme ich ins Büro und das Makro geht nicht mehr...
Es bearbeitet nicht mehr die Dateien in den Ordnern, wo liegt denn der Fehler?
Vielen Dank.
Option Explicit
Sub MWMultiDateiUpdate()
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Dim lngLetzteZeile As Long
Dim lngLetzteSpalte As Long
Dim BrowseDir As Variant
Dim AppShell As Object
Application.ScreenUpdating = False 'Das "Flackern" ausstellen
'Schritt 1: Schleife über alle Excel Dateien in einem Verzeichnis
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
On Error Resume Next
sPfad = BrowseDir.items().Item().Path
'sPfad = "C:\Users\ve0x4s\Downloads\TEST"
If sPfad = "" Then Exit Sub
On Error GoTo 0
sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
Do While sDatei ""
'Schritt 2: öffnen der Datei und Datenübertragung
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, False) 'nur lesend öffnen
'Änderungen durchführen
'Ermittle erste Zeile und letzte Spalte
lngLetzteZeile = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
lngLetzteSpalte = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
'Bereich markieren
Sheets(1).UsedRange.Select
'Tabelle erstellen
Sheets(1).ListObjects.Add(xlSrcRange, Sheets(1).UsedRange, , xlYes).Name = _
"SicherheitsCheck"
'Unternehmensorange auf Tabelle anwenden
Sheets(1).ListObjects("SicherheitsCheck").TableStyle = "TableStyleMedium3"
'Spalten markieren und an Inhalt anpassen
Columns("A:A").Select
Range(Selection, Selection.End(xlToRight)).Select
Columns.EntireColumn.AutoFit
'Schritt 3: Datei speichern und wieder zu machen und nächste Schleifenrunde
Application.DisplayAlerts = False
oSourceBook.Close True 'speichern
Application.DisplayAlerts = True
'Nächste Datei
sDatei = Dir()
Loop
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
'Variablen aufräumen
Set oSourceBook = Nothing
End Sub