Public varFSArr As Variant
Public varArr As Variant
Sub Strom()
Dim varArr2 As Variant
Dim lngCount As Long, lngCount2 As Long
Dim dtmDateTime As Date
Dim lngFFn As Long
Dim blnJo As Boolean
Dim lngSpalte As Long
Dim lngZeile As Long
Dim wksZL As Worksheet
Dim varSB As Variant
varSB = Application.StatusBar
'Verzeichnis-/Dateistruktur der CSV-Files aufsammeln
'===================================================
ReDim varFSArr(0)
SuchRoot ("C:\001_Test\SN_Downloads\Stromzaehler") '!!!hier Verzeichnis mit den Ganzen Daten angeben/anpassen
'vollstaendige Timestamp-Liste basteln
'=====================================
dtmDateTime = #4/1/2010#
lngCount = 0
ReDim varArr(1 To 1, 1)
Do
lngCount = lngCount + 1
If UBound(varArr, 2) <= lngCount Then ReDim Preserve varArr(1 To 1, 1 To UBound(varArr, 2) + 10000)
varArr(1, lngCount) = "'" & Replace(Format(dtmDateTime, "yyyy,mm,dd,hh,mm"), ",", "")
dtmDateTime = dtmDateTime + TimeValue("00:15:00")
Loop Until dtmDateTime >= #4/1/2011#
ReDim Preserve varArr(1 To 1, 0 To lngCount)
ReDim varArr2(0 To lngCount, 0 To 1)
For lngCount = 0 To UBound(varArr, 2) Step 1
varArr2(lngCount, 0) = varArr(1, lngCount)
Next lngCount
ReDim varArr(0)
'Dateien durchgehen
'==================
For lngCount = 0 To UBound(varFSArr) Step 1
If LCase(Right(varFSArr(lngCount), 3)) = "csv" Then
'Statusbar beschreiben zur Laufkontrolle
Application.StatusBar = "Verarbeite: " & varFSArr(lngCount)
'CSV in Array einlesen
CSVtoArr (varFSArr(lngCount))
blnJo = False
'Zaehlerspalte suchen ggf. neu anlegen
For lngCount2 = 1 To UBound(varArr2, 2)
If varArr(2, 1) = varArr2(0, lngCount2) Then blnJo = True: Exit For
Next lngCount2
If blnJo Then
lngSpalte = lngCount2
ElseIf lngCount2 = 2 And varArr2(0, 1) = "" Then
lngSpalte = lngCount2 - 1
varArr2(0, 1) = varArr(2, 1)
Else
lngSpalte = lngCount2
ReDim Preserve varArr2(LBound(varArr2, 1) To UBound(varArr2, 1), 0 To lngSpalte)
varArr2(0, lngSpalte) = varArr(2, 1)
End If
'Zaehlerwerte einsortieren
For lngCount2 = 2 To UBound(varArr, 1) Step 1
For lngZeile = 1 To UBound(varArr2, 1) Step 1
If varArr(lngCount2, 2) = varArr2(lngZeile, 0) Then _
varArr2(lngZeile, lngSpalte) = varArr(lngCount2, 3) _
: Exit For
'End If
Next lngZeile
Next lngCount2
End If
Next lngCount
'Array in Tabelle1 schreiben
'===========================
With ThisWorkbook.Worksheets("Tabelle1")
.Cells(1, 1).Resize(UBound(varArr2, 1), UBound(varArr2, 2) + 1).NumberFormat = "General"
.Cells(1, 1).Resize(UBound(varArr2, 1), UBound(varArr2, 2) + 1) = varArr2
.Cells(1, 1).ClearContents
End With
Application.StatusBar = varSB
End Sub
Private Sub CSVtoArr(ByVal strFile As String)
'aus
http://www.ms-office-forum.net/forum/showpost.php?p=1361276&postcount=2
'entnommen und angepasst
Dim fso
Dim datei
Dim arr
Dim L As Long
Dim I As Integer
Dim arrTmp As Variant
Const spalten = 3
Set fso = CreateObject("scripting.filesystemobject")
Set datei = fso.opentextfile(strFile)
arr = Split(datei.readall, vbCrLf)
datei.Close
ReDim varArr(1 To UBound(arr), 1 To spalten)
For L = LBound(arr) To UBound(arr)
arrTmp = Split(arr(L), ";")
For I = LBound(arrTmp) To UBound(arrTmp)
If IsNumeric(Trim(arrTmp(I))) Then _
varArr(L + 1, I + 1) = CDbl(Trim(arrTmp(I))) _
Else varArr(L + 1, I + 1) = Trim(arrTmp(I))
Next
Next
Set fso = Nothing
Set datei = Nothing
End Sub
Private Sub SuchRoot(strQuelle As String)
'Variablen
'=========
Dim objFS As Object
Dim fldQuelle As Object
Set objFS = CreateObject("Scripting.FileSystemObject")
Set fldQuelle = objFS.GetFolder(strQuelle)
Verzeichnisse fldQuelle
Set fldQuelle = Nothing
Set objFS = Nothing
End Sub
Private Sub Verzeichnisse(objFld As Object)
'!!!Rekursiver Aufruf!!!
'aus "Sub SuchRoot" heraus angestossen
'Variablen
'=========
Dim objSubFld As Object
Dim objFile As Object
Dim objFS As Object
Set objFS = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFld.Files
ReDim Preserve varFSArr(UBound(varFSArr) + 1)
varFSArr(UBound(varFSArr)) = objFile.Path
Next objFile
For Each objSubFld In objFld.SubFolders
Verzeichnisse objSubFld
Next
Set objFS = Nothing
Set objFld = Nothing
Set objSubFld = Nothing
End Sub
