Moin zusammen,
ich habe mal wieder eine kleine VBA Herausforderung gefunden, die ich vorher versucht habe per VBS zu lösen, bin da aber auch nicht weit gekommen.
Was ich vorhabe ist folgendes:
1. Button in xlsx -> Input Form für Pfadeingabe
2. Nach klick auf OK -> Auflistung aller Excel Dateien in diesem Pfad: Name der Datei; Anzahl der ausgefüllten Zeilen (minus Überschrift) + eine Zelle für Gesamtsumme aller Zeilen
Ich konnte in der Suche nichts genaues finden.
Hat jmd. von euch evtl. dieses Problem schon einmal gelöst?
Danke euch für Ideen
Cheers,
xlsxvba
ich habe aus einem ehemaligen Makro, was ich mir mal zusammengesucht / -gebaut habe nun das hier geschrieben:
Code:
Option Explicit
Public x() 'für Datei Attribute(?)
Public I As Long
Public FSO, oFolder, Fil
Public objShell, objFolder, objFolderItem
Sub MainExtractData()
Dim NewSheet As Worksheet
Dim MainFolderName As String
On Error GoTo ErrorHandler
ReDim x(1 To 65536, 1 To 11)
Set objShell = CreateObject("Shell.Application")
Application.ScreenUpdating = False
MainFolderName = InputBox("Please enter the path, where the Excel files are stored! (\\...\etc.): ")
If StrPtr(MainFolderName) = 0 Then Exit Sub 'wenn hier auf Abbrechen geklickt wird, erscheint kein Fehler
Set NewSheet = ThisWorkbook.Sheets.Add
'x(1, 1) = "Path"
x(1, 1) = "File Name"
x(1, 2) = "Number of Rows"
x(1, 3) = "Total Rows:"
'x(1, 4) = 'Summe aller gezählten Zeilen' --> wie hier am besten lösen?
I = 1
Set FSO = CreateObject("scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(MainFolderName)
On Error Resume Next
For Each Fil In oFolder.Files
Set objFolder = objShell.Namespace(oFolder.Path)
Set objFolderItem = objFolder.ParseName(Fil.Name)
I = I + 1
'x(I, 1) = oFolder.Path
x(I, 1) = Fil.Name
'x(I, 2) = Count Number of Rows
Next
With Range("A1").Resize(I, 11) 'hier A1 anpassen, wenn in anderer Zelle Input starten soll
.Value = x
.WrapText = False
.EntireColumn.AutoFit
.Rows(1).Font.Bold = True
.Rows(2).Select
ActiveWindow.FreezePanes = True
.Range("A1").Activate
End With
Set FSO = Nothing
Set objShell = Nothing
Set oFolder = Nothing
Set objFolder = Nothing
Set objFolderItem = Nothing
Set Fil = Nothing
Application.StatusBar = ""
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
If Err = 76 Then 'Error 76 wird hier abgefangen, wenn Pfadangabe inkorrekt
MsgBox "Bitte einen korrekten Pfad angeben" '& Err.Description & Err.Number
End If
If Err <> 0 And Err <> 76 Then 'für alle anderen Fehler außer Fehler 76
MsgBox "Unerwarter Fehler"
End If
End Sub
Es fehlt allerdings noch eine Funktion, um die Zeilen - 1 in den jeweiligen Excel Dateien zu zählen und eine Funktion, die mir die Summe aller gezählten Zeilen in die Zelle D1 schreibt.
Könnt ihr mir sagen, wie ich das ergänzen kann?
Besten Dank & VG!!
Zur Frage mit der Summe sollte doch an sich das hier gehen:
Code:
x(1, 4) = Range("D1").Formula = "=Sum(B2:B10000)"
... gibt mir aber nur ein "FALSCH" zurück.
Wäre euch sehr dankbar für 1-2 Tipps :)
Hallöchen,
mit Deinem Code erhälst Du das Ergebnis eines Vergleichs. WAHR würde kommen, wenn die Formel in D1 der programmierten entspricht.