31.05.2012, aktualisiert um 13:58:48 Uhr

7690

Tägliche logs als neues Tabellenblatt erstellen

Mahlzeit zusammen,

wenn man an die Grenzen stößt, mit einer Frage sich nicht entblößt ... oder so.

Also weg vom Vorwort und ab zum Kern:

Vorhaben
Täglich wird in einem regulären XX-Minuten-Takt ein ping-log am Server erstellt, diese sollen nun monatlich in eine Datei gepackt werden (csv oder xls[x]).

Hintergrund
Warum das Ganze kann man sich fragen ... ganz einfach, die momentane ADSL-Verbindung ist einfach unter aller Kanone für einen Betrieb im Mittelstand, allerdings gibt es keine nahe günstige Alternative, dennoch möchte ich die Verbindung im gesamten Maße aufzeichnen, denn nur zu sagen: Lief mal wieder sehr langsam, viele Verbindungsabbrüche ist als Druckmittel für eine Finanzierung des Ausbaus des Anschlusses bei der GF nun einmal etwas mager

Was bisher geschah
Bisher habe ich ganz gewöhnliche Textdateien .log erstellt, was mir aber auch nicht gefiel, daher ist der aktuelle Stand das Erstellen einer täglichen .csv Datei mittels einer batch:

@echo off & setlocal
for /f "tokens=1-3 delims=." %%s in ('echo %date%') do (  
	set "Datum=%%u-%%t-%%s"  
	set "Jahr=%%u"  
	set "Monat=%%t"  
)

if "%time:~0,1%" equ " " (set "Zeit=0%time:~1,4%") else (set "Zeit=%time:~0,5%")  

set "Pfad=D:\Latenz\%Jahr%\%Monat%"  
if not exist "%Pfad%" md "%Pfad%"  

set "log=%Pfad%\%Datum%_ping.csv"  
if not exist "%log%" echo Uhrzeit;Min [ms];Max [ms];Mit [ms];Verlust [%%]>"%log%"  

for /f "skip=3 tokens=1-12 delims=,( " %%a in ('ping /n 20 google.de^|findstr /V /B "Ping Antwort Ca."') do (  
	set "Min=%%c" & set "Max=%%f" & set "Mit=%%i" & if not defined lost set "lost=%%k"  
)
>>"%log%" echo %Zeit%;%Min:~,-2%;%Max:~,-2%;%Mit:~,-3%;%lost:~,-1%  

Und so hat man jetzt Verzeichnisse voller 2012-05-31_ping.csv etc. deren Ausgabe so ausschaut:

Uhrzeit;Min [ms];Max [ms];Mit [ms];Verlust [%]
00;33;34;33;0
30;33;35;34;0
00;34;35;34;0
30;33;91;36;0
00;33;56;36;0
30;33;34;33;0
00;34;43;34;0
30;33;63;35;0
00;33;52;34;0
30;33;35;34;0
00;34;35;34;0
30;33;35;33;0
00;33;48;34;0
30;34;39;34;0
00;33;49;33;0
30;32;56;34;0
00;34;277;106;0
30;33;34;33;0
00;34;123;39;0
30;32;35;33;0
00;34;35;34;0
30;34;35;34;0
00;33;64;37;0
30;32;34;33;0
00;34;35;34;0
30;33;36;34;0
00;33;93;37;0
30;33;34;33;0
00;33;34;33;0
30;33;36;33;0
00;33;37;33;0
30;30;33;31;0
00;31;37;31;0
30;32;33;32;0
00;31;32;31;0
30;31;32;31;0

Was die Zukunft bringen wird
Das Abschaffen der einzelnen Dateien ist nun das Ziel, diese automatisiert als neues Tabellenblatt (Name des Blattes equ %Datum%) in einer monatlichen Datei hinten anzuhängen.
Ob das mit einer csv geht oder nur mit einer richtigen Excel-Datei (Office 2007 hier nutzbar), weiß ich nicht aber ich bin mir sicher, dass dies sicherlich via VBS(-inliner) lösbar ist und sich somit meiner Kenntnis entzieht ^__^

Zusammenfassung
2012-05-01_ping.csv - 2012-05-31_ping.csv => 2012-05_ping.csv mit den Tabellenblättern 2012-05-01 bis 2012-05-31

Na, dann hoffe ich mal auf eure Hilfe

Gruß,

André

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 185708

Url: https://administrator.de/forum/taegliche-logs-als-neues-tabellenblatt-erstellen-185708.html

Ausgedruckt am: 24.12.2024 um 19:12 Uhr

53 Kommentare

Neuester Kommentar

Moin André,

ein paar Fragen:

besteht jeweils die Möglichkeit:

das Datum zur Uhrzeit zu speichern?
je Monat eine csv-Datei zu erzeugen?
die Excel-Datei mit einem Tabellenblatt pro Monat zu strukturieren?

Hintergrund ist, dass ein Einlesen der csv-Dateien nach Excel zwar simpel ist, die Abfrage, welche die letzte, komplett eingelesene csv ist - resp. wenn die letzte zum Einlesezeitpunkt nicht komplett war, wieviele Zeilen dann zu löschen etc. pp. ...

Liegt nur eine Datei je Monat vor, wird dieser Prozess einfacher (i.e. Datei ist komplett, wenn neuer Monat), außerdem wird die Excel-Datei übersichtlicher (nur 12 Blätter á 31 x 24|48 Einträge).

Freundliche Grüße von der Insel - Mario

Aloha Mario,

wo ist jetzt der funktionale Unterschied der Abarbeitung?

Wenn du es für einfacher hälst eine Jahres-Excel-Datei mit 12 Blättern à eine eingelesene CSV-Datei zu verarbeiten, sehe ich den Unterschied zu einer Monats-Excel-Datei mit i.d.R. 30-31 Blättern à eine eingelese CSV-Datei nicht.

Was für Zeilen willst du löschen?

Pro Monat eine CSV-Datei wäre m.M.n. total banane bei 15-30 minütigen Abfragen, wo soll ich da noch einen klaren Überblick behalten?

Timo hatte mir per PM den PRTG Network Monitor vorgeschlagen aber der ist derzeit einfach zu viel des Guten.

greetz André

Moin André,

Zitat von @Skyemugen:
wo ist jetzt der funktionale Unterschied der Abarbeitung?

Wenn der Zeitpunkt des Einlesens in Excel nicht genau feststeht, sondern vom User willkürlich vorgenommen wird, kann es beispielsweise vorkommen, dass die csv-Datei eines Tages um 16:00 Uhr eingelesen wird - wenn diese also noch nicht komplett (für den Tag) ist. Ein nachfolgendes Einlesen, etwa einen Tag später, muss also zunächst feststellen, welche Zeilen des vergangenen Tages evtl. schon eingelesen wurden und muss nun
- entweder diese löschen und den Tag neu einlesen, oder
- alle nicht vorhandenen Zeilen dazulesen.

Da Du leider nichts über das Management der vorhandenen csv-Dateien (löschen, archivieren etc.) schreibst (und ebensowenig über das Einlesemanagement in Excel), halte ich es für sinnvoller, eine monatliche csv-Datei (dann inkl. Datumsfeld) zu jedem beliebigen Zeitpunkt in Excel einzulesen - alle bis dahin in der csv gesammelten Einträge sind dann in Excel vorhanden.

Wenn du es für einfacher hälst eine Jahres-Excel-Datei mit 12 Blättern à eine eingelesene CSV-Datei zu verarbeiten, sehe ich den Unterschied zu einer Monats-Excel-Datei mit i.d.R. 30-31 Blättern à eine eingelese CSV-Datei nicht.

Sollte auf der Hand liegen - sowohl beim Einlesen als auch bei der Auswertung ... Ansonsten favorisiere ich eine Jahresdatei - schon aus Gründen der Übersichtlichkeit.

Was für Zeilen willst du löschen?

Siehe oben.

Pro Monat eine CSV-Datei wäre m.M.n. total banane bei 15-30 minütigen Abfragen, wo soll ich da noch einen klaren Überblick behalten?

Ich war der Annahme, dass Du Dir den Überblick eben durch Excel verschaffen wolltest?! Und was 31 csv-Dateien gegenüber 1 csv-Datei für Vorteile haben sollen ...

Timo hatte mir per PM den PRTG Network Monitor vorgeschlagen aber der ist derzeit einfach zu viel des Guten.

Per PM kann ich auch ... Dir z.B. eine solche Excel-Lösung zusenden ...

Freundliche Grüße von der Insel - Mario

Zitat von @mak-xxl:

??? Skript? Automatisiert? Taskplaner? Wenn ich was per Hand machen will, müsste ich hier ja nicht anfragen ... P.S.: Der User bin nur ich, sonst hat hier niemand etwas mit diesen Sachen zu tun

Da Du leider nichts über das Management der vorhandenen csv-Dateien (löschen, archivieren etc.) schreibst

CSV => Excel & CSV löschen, logisch, dachte ich ...

(und ebensowenig über das Einlesemanagement in Excel)

??? Genau darum dreht sich doch der ganze Thread?

Ich war der Annahme, dass Du Dir den Überblick eben durch Excel verschaffen wolltest?! Und was 31 csv-Dateien gegenüber
1 csv-Datei für Vorteile haben sollen ...

??? Wieso 31 CSV-Dateien, die habe ich momentan, genau darum will ich monatlich ja nur EINE Excel-Datei (12 also pro Jahr, da der monatliche Überblick dann einfacher fällt, wenn alles untereinander ist, weiß ich nicht, wo der Überblick sein soll ...)

Also noch einmal: Die Vorstellung war:
Täglich wird eine CSV erstellt (geschieht bisher - geht ja nur bis 23:30), diese soll dann via Skript (VBS [?]) als neues Arbeitsblatt in die für den Monat zuständige Excel-Tabelle eingelesen und danach wird die CSV gelöscht werden.
Bei einem neuen Monat soll eine neue Excel-Datei erstellt werden.

Ich möchte aus einem einfachen Grund keine Jahresdatei: Das Vergleichen von evtl. Stoßzeiten fällt beim Herabscrollen weniger leicht als wenn ich einfach auf das nächste Blatt wechsle, da die Uhrzeiten dann alle genau dieselben Zeilen haben.

greetz André

Hallo André

nun gibst du immer so viel Hilfe beim Batchen und bei deinem eigenen kleinen Problem wirst du mit so vielen Gegenfragen und Meinungen konfrontiert.
Nun Ja, ich habe mir überlegt, dir was in VBS zu basteln. Aber gib mir etwas Zeit. Ich denke, in den nächsten Tagen kriegen wir das hin.
Also zuerst zu meinem Verständnis:
1) Ordner einlesen mit den CSV-Dateien die da irgendwie 01.xx.JJJJ bis (maximal) 31.xx.JJJJ sind
2) Eine Excel-Datei anlegen die von Tabellenblatt 1 bis maximal 31 den Namen der CSV-Datei hat, respektive nur den Datumspart
3) Alle Daten aus dieser CSV in besagtes Tabellenblatt speichern und
4) dann die eingelesene CSV-Datei löschen.

Das lässt sich alles machen in VBS und ich würde mich freuen, dir auf diesem Wege VBS etwas näher zu bringen. Beim Batchen kann ich dir das Wasser nicht reichen!

Schönen Samstag und viele Grüße

Tsuki

Hallo Andre,

hier mal ein "Gerüst" in VBS. Ich denke, du solltest das nicht in deine schöne Batch integrieren!
Weil auf die Schnelle und ungetestet, bitte teste das mal und wir müssen noch ein Finetuning machen! Aber vielleicht kommst du auf die ein oder andere Sacher selber.
Viele Grüße
Tsuki

Dim Ordner, Pfad, DateiFilter
Dim Dateiliste
Dim FSO
Dim ObjXls
Dim Trennzeichen

Trennzeichen = ";"  
DateiFilter = "CSV"  

Set FSO = CreateObject("Scripting.FileSystemObject")  

OrdnerAuswaehlen
msgbox Pfad

DateienEinlesen(Pfad)

Private Sub OrdnerAuswaehlen()

AuswahlTitel = "Bitte Ordner auswählen"  
StartOrdner = "17"  
Set Auswahl = CreateObject("Shell.Application").BrowseForFolder(0,AuswahlTitel,16,StartOrdner)  
If TypeName(Auswahl) = "Nothing" Then  
    MsgBox "Abbruch gewählt!"  
    WScript.Quit
Else
    Set Ordner = Auswahl.Self
    Pfad = Ordner.Path
End If

End Sub

Private Sub DateienEinlesen(SuchOrdner)
	Set Ordner = FSO.getfolder(SuchOrdner)
	For Each file In ordner.files
		Pfadangabe =File.path
		If LCase(Right(Pfadangabe,3)) = LCase(DateiFilter) Then
			SuchDateien = SuchDateien & Pfadangabe & vbcrlf
		End If
	Next
	Set ObjXls = CreateObject("Excel.Application")  
	objXLS.Workbooks.Add
	objXLS.Visible = False
		a = Split(SuchDateien, vbcrlf)
		For i = 0 to (Ubound(a) - 1)
			b = Split(a(i),"\")  
			objXLS.Sheets.Add
    			objXLS.Sheets("Tabelle" & i + 1).Select  
    			TempName = Left(b(UBound(b)), 10)
                		ObjXls.Sheets("Tabelle" & i + 1).Name = TempName  
            			ObjXls.Sheets(TempName).Select
			Set MeineDatei = FSO.OpenTextFile(a(i), 1)
			MeineDaten = Split(MeineDatei.ReadAll,vbcrlf)
			For j = 0 to Ubound(MeineDaten)
				c = Split(MeineDaten(j), Trennzeichen)
                			For k = 0 To (UBound(c))
               			 On Error Resume Next
                    				Zeile = Chr(65 + k) & (j + 1)
                                			ObjXls.Range(Zeile).Value = c(k)
                			Next
			Next
			MeineDatei.Close
		Next
	ObjXLS.ActiveWorkbook.SaveAs Pfad & "\Test.xls"  
    	ObjXLS.ActiveWorkbook.Close
	
	Msgbox SuchDateien
End Sub

achso, André!

ob das mit Office 2007 funktioniert, das weiss ich überhaupt nicht! Aber bis Office 2003 sollte sich was tun.

Gruss
Tsuki

Hallo Tsuki!

Eine (vermutlich performantere und jedenfalls in Office 2007 funktionierende) Alternative für die Zeilen 53 bis 60 könnte etwa so aussehen:

Sp = UBound(Split(MeineDaten(0), Trennzeichen)) + 1 'Spaltenanzahl vorweg ermitteln  
For j = 0 To UBound(MeineDaten)
    ObjXls.Cells(j + 1, "A").Resize(1, Sp).Value = Split(MeineDaten(j), Trennzeichen) 'Datensatz ab Spalte A in Zeile j + 1 eintragen  
Next

Grüße
bastla

[Edit] Sollte jetzt über VBS verwendbar sein [/Edit]

Hallo bastla,

danke für den Tipp! Da wird sich André sicher drüber freuen

Ich habe kein Office über dem 2003-er hinaus und bin mir nicht sicher, ob meine Idee mit 2007 überhaupt geht. Scheint sie aber doch

Schöne Woche und viele Grüße

Tsuki

Ps.: In meiner Idee oben muss noch einiges gemacht werden, damit es sauber funktioniert. Vielleicht hat André ja Lust gemeinsam dazu

Hallo Tsuki!

In meiner Idee oben muss noch einiges gemacht werden

... wobei allerdings zu unterscheiden wäre, oe es um ein Aufarbeiten kompletter "Monats"-Ordner (wie in Deinem aktuellen Ansatz) gehen soll (dann würde ich noch an eine Sortierung der Tabellenblätter auf Basis der Dateinamen - ev auch gleich vorweg - denken) oder ob in weiterer Folge (jeweils per Taskplaner zB um 23:40 aufgerufen - damit würden Marios Bedenken hinsichtlich nicht kompletter Daten wegfallen) nur die Datei des aktuellen Tages der (bereits existierenden) Excel-Datei hinzuzufügen wäre ...

Grüße
bastla

Hallo bastla,

genau! Diese Fragen sollte uns Andre beantorten, wei er's gern hätte

Bei mir wird noch nicht sortiert und nicht gelöscht und auch erst einmal nur eine Test.xls erstellt. Mein bisschen Schnipsel da oben zeigt erst einmal nur den Weg des möglichen. Deswegen, noch jede Menge Finetuning. Und da Andre es ja ganz alleine später betreiben möchte, können wir's gern massgeschneitert schreiben

Aber warten wir erst einmal seine Meinungen dazu ab.

Vielen Dank und viele Grüße

Tsuki

Aloha ihr beiden und Danke für eure Anteilnahme der Thematik

nach einem ziemlich PC-armen Wochenende, stehe ich jetzt erst einmal vor euren Kommentaren, hehe.

Werde es im Laufe des Tages durchtesten, derzeit habe ich wichtige Konstruktionen auf dem Tisch immer wieder Montags ...

Auf bastlas wobei einzugehen: Da ich anfangs kein Komplettpaket à la VBS dachte, sondern an eine Aufarbeitung, hätte ursprünglich diese Aufarbeitung um 23:50 als 2. Task stattgefunden (daher verstand ich auch nie, was Mario mit wegfallen von Daten etc. meinte).

Aber wie gesagt: Das Gerüst dort oben werde ich heute mal testen und mein Feedback geben.

Bis dahin ... hoffen wir mal, dass der Montag auf Arbeit weniger wolkig als das Wetter wird

greetz André

Hallo @all!

@andré
Und wenn Du schon beim testen bist, dann hier noch eine Variante, die automatisiert den Ping absetzt und das Ergebnis direkt in die Excel-Tabelle einträgt.

Ablauf:
Ping absetzen
Cmd-Ausgabe einlesen und auswerten
Gegebenenfalls Ordner Jahr erstellen
Gegebenenfalls Ordner Monat erstellen
Gegebenenfalls ein Sheet pro Tag hinzufügen

Dieses Skript erstellt pro Monat eine neue Excelmappe mit einem Schreib-Passwort, d.h. die Excelmappe erhält einen Schreibschutz und kann auch während einer Taskausführung schreibgeschützt zur Ansicht geöffnet werden.

Was allerdings noch fehlt, ist der einmalige Datenimport der vorangegangenen Monate und Tage in einer Ruhephase

    Option Explicit

    Const PathStart = "D:\Latenz"  

    Const CmdPrompt = "ping /n 20 google.de"  

    Const ExcelMappe = "Ping.xls"  

    Const ExcelHeader = "Uhrzeit,Min [ms],Max [ms],Mit [ms],Verlust [%]"  

    Const ErrMsg1 = "Pfad nicht gefunden:"  
    Const ErrMsg2 = "Excel-Datei nicht gefunden:"  

    Const xlUp = -4162
    Const xlRight = -4152
    Const xlCenter = -4108
   

    Dim objShell, objExec, objRegExp, objMatches, objFso, objExcelApp, objExcelSheet, arrValues
    Dim strDate, strTime, strYear, strMonth, strDay, strStdOut, strPathYear, strPathMonth
    Dim strPathExcelMappe, intNextLine, intNewSheets
    
    Set objShell = CreateObject("WScript.Shell")        'Object Shell  
    
    strTime = FormatDateTime(Time, vbShortTime)         'Format HH:MM  
    
    Set objExec = objShell.Exec(CmdPrompt)              'Ping ausführen  
    
    strStdOut = LCase(objExec.StdOut.ReadAll)           'Cmd-Ausgabe einlesen  
    
    strYear = Year(Date)                                'Format YYYY  
    strMonth = Right("0" & Month(Date), 2)              'Format MM  
    strDay = CStr(Day(Date))                            'Format #D)  
    
    strDate = strYear & "-" & strMonth & "-" & Right("0" & strDay, 2)     'Format YYYY-MM-DD  
    
    Set objRegExp = New RegExp                          'Object Regular-Expression  
    
    With objRegExp
       .Global = False                                  'Mehrmaliges Vorkommen = False  
       .IgnoreCase = True                               'Klein/Großschreibung ignorieren  
       .Pattern = "verloren =[^\(]*\((\d+)[^=]*= (\d+)[^=]*= (\d+)[^=]*= (\d+)"  'Filter (Verlust,Min,Max,Mittel)  
    End With
    
    arrValues = Array(strTime, "n/v", "n/v", "n/v", "n/v")  'Verbindungsfehler (Zeit,Min,Max,Mittel,Verlust)  
    
    Set objMatches = objRegExp.Execute(strStdOut)       'Cmd-Ausgabe filtern  
    
    If objMatches.Count Then                            'Test Filtern erfolgreich  
        With objMatches(0).SubMatches
            If .Count = 4 Then                          'Test ob alle Werte vorhanden sind  
                arrValues = Array(strTime, .Item(1), .Item(2), .Item(3), .Item(0))  'Werte (Zeit,Min,Max,Mittel,Verlust)  
            End If
        End With
    End If
    
    strPathYear = PathStart & "\" & strYear                 'Path "D:\Latenz\Jahr"  
    strPathMonth = strPathYear & "\" & strMonth             'Path "D:\Latenz\Jahr\Monat"  
    strPathExcelMappe = strPathMonth & "\" & ExcelMappe     'Path "D:\Latenz\Jahr\Monat\ExcelMappe"  
    
    Set objFso = CreateObject("Scripting.FileSystemObject") 'Object Dateioperationen  

    If objFso.FolderExists(PathStart) Then                  'Test ob der PathStart existiert  
        If objFso.FolderExists(strPathYear) = False Then    'Test ob der Pfad mit Jahr nicht existiert  
            objFso.CreateFolder strPathYear                 'Pfad mit Jahr erstellen  
        End If
        
        Set objExcelApp = CreateObject("Excel.Application") 'Object ExcelApplication  
        
        If objFso.FolderExists(strPathMonth) Then           'Test ob der Pfad mit Monat existiert  
            If objFso.FileExists(strPathExcelMappe) Then    'Test ob Excel-Datei vorhanden ist  
                With objExcelApp.Workbooks.Open(strPathExcelMappe, , , , , "Write") 'Excel-Datei öffnen (Schreibberechtigt)  
                    Set objExcelSheet = Nothing             'Object Excel-Sheet = Nothing  
                    
                    On Error Resume Next                    'Fehlerbehandlung Aus  
                    Set objExcelSheet = .Sheets(strDay)     'Object Excel-Sheet = Monat?  
                    On Error GoTo 0                         'Fehlerbehandlung Ein  
                    
                    If objExcelSheet Is Nothing Then        'Test Excel-Sheet Monat existiert nicht  
                        Set objExcelSheet = .Sheets.Add(, .Sheets(.Sheets.Count))
                        Call SheetInit(objExcelSheet, strDay, arrValues)
                    Else    'Wenn Sheet (Tag) bereits existiert  
                        With objExcelSheet
                            intNextLine = .Cells(.Rows.Count, "A").End(xlUp).Row + 1  'Nächste freie Zeile  
                           .Cells(intNextLine, "A").Resize(1, 5).Value = arrValues    'Werte einfügen  
                        End With
                    End If
                        
                   .Close True  'Excel-Mappe speichern und schließen  
                End With
            
            Else
                MsgBox ErrMsg2 & vbCr & vbCr & strPathExcelMappe, vbExclamation, "Fehler..."  
            End If
       Else
            objFso.CreateFolder strPathMonth                        'Pfad mit Monat erstellen  
            
            With objExcelApp
                intNewSheets = .SheetsInNewWorkbook                 'Option Anzahl Sheets sichern  
               .SheetsInNewWorkbook = 1                             'Option Anzahl Sheets = 1  

                With .Workbooks.Add                                 'Neue Excel-Mappe erstellen  
                    Call SheetInit(.Sheets(1), strDay, arrValues)
                   .SaveAs strPathExcelMappe, , , "Write"           'Excel-Mappe mit Schreibkennwort speichern  
                   .Close False                                     'Excel-Mappe schließen  
                End With
            
               .SheetsInNewWorkbook = intNewSheets                  'Option Anzahl Sheets wiederherstellen  
            End With
        End If
        
        objExcelApp.Quit                                        'Excel-Application schließen  
    Else
        MsgBox ErrMsg1 & vbCr & vbCr & PathStart, vbExclamation, "Fehler..."  
    End If


Private Sub SheetInit(ByRef Sheet, ByRef SheetName, ByRef Values)
    With Sheet                                      'Sheet("TabelleX")  
       .Name = SheetName                            'Sheet-Name = Tag X  
       .Range("A:E").HorizontalAlignment = xlRight  'Spalten rechtsbündig  
        
        With .Range("A1").Resize(1, 5)              'Zell-Bereich A1:E1 festlegen  
            .Value = Split(ExcelHeader, ",")        'Überschrift einfügen  
            .Font.Bold = True                       'Fett-Schrift festlegen  
            .HorizontalAlignment = xlCenter         'Überschrift zentrieren  
        End With
                
       .Range("A2").Resize(1, 5).Value = Values     'Werte in Zeile 2 einfügen  
    End With
End Sub

Gruß Dieter

[edit] Code insoweit geändert, dass beim Erstellen einer neuen Arbeitsmappe nur 1 Sheet vorhanden ist. [/edit]

Aloha erneut, ob den Edit einer liest, Doppelpost komm in meine Arme *fg*

sooo ... mit TsukiSans Ausfühung habe ich momentan eine .xls (Excel meckert rum:
Sie versuchen eine Datei zu öffnen 'Test.xls' deren Format von der in den Dateierweiterung abweicht ... bla bla bla nicht beschädig bla bla usw.) die wie folgt aufgebaut ist:

2012-06-04

Tabelle 5

2012-06-01

Tabelle 6

2012-06-02

Tabelle 7

2012-06-03

mit den richtigen Inhalten bisher in den Datums-Tabellenblättern.

Für den letzten Monat, mit 31 Dateien sah es dann so aus:

Tabelle 32

- bis -

Tabelle 33

- bis -

Tabelle 31

- bis -

bastlas Vorschlag endete mit einem Typen unverträglich 'Cells'

greetz André

P.S.: Frühstück

Hallo Skye!

Da ja über VBS gestartet wird (ich aber gleich direkt in Excel getestet habe), fehlt (das für alle Excel-Objekte benötigte) "ObjXls." vorweg (ließe sich auch mit einem "With" pauschal erledigen) - ich ergänze das mal oben ...

Grüße
bastla

Aloha Dieter,

na, das sieht doch schon einmal klasse aus, das Einzige hierbei ist, jede neue Standard-Datei enthält ja drei Tabellen, sodass er zwar den ersten Eintrag in Tabelle 1 setzt, allerdings wenn ich das Datum für morgen einstelle, um einen fortlaufenden Test zu haben, dann kommt diese ans Ende

Tabelle 2

Tabelle 3

Auch bei dieser erstellten .xls kommt die Ansage

Sie versuchen eine Datei zu öffnen 'Ping.xls' deren Format von der in den Dateierweiterung abweicht ... bla bla bla nicht beschädig bla bla usw.)

Excel ist wohl empfindlich von nicht selbst erstellten Dateien

Sonst funktioniert es bisher prima.

@bastla, ja funktioniert jetzt

greetz André

Hallo André!

Sorry, von einer bereits erstellten Standard-Datei bin ich nicht ausgegangen. Mein Plan war, für jeden Monat eine Neue Arbeitsmappe automatisiert zu erstellen und für jeden Tag (Tabellennamen 1 ,2 ,3 ... 31) ein neues Sheet zu erstellen...

Leider habe ich jetzt auch keine Zeit, da ich gleich zur Arbeit muss und erst sehr spät (hundemüde) nach Hause komme, aber vielleicht kann sich ja bastla ein wenig damit beschäftigen?

Gruß Dieter

Zitat von @76109:

Sorry, von einer bereits erstellten Standard-Datei bin ich nicht ausgegangen

Ist auch nicht die Rede. Es wird eine neue erstellt, diese enthält standardmäßig dennoch die ausgefüllte Tabelle des ersten Tages sowie Tabelle 2 und Tabelle 3

greetz André

sowie Tabelle 2 und Tabelle 3

Hallo Andre,

nur ganz kurz: Die lassen sich noch rauslöschen, diese Standarttabellen.
Zu den Meldungen, die du da immer bekommst, dass könnte wohl damit zusammenhängen, dass die Exceldateien ab 2007 auf .xlsx enden. Das kann ich aber nicht testen und sollte aber auch nicht stören

@Dieter,

ich glaube wir haben denselben Job nur mit dem Unterschied, dass ich das Haus morgens schon hundemüde verlasse

Bis später und Gruss

Tsuki

Hallo André!

Heute Mittag stand ich wegen Zeitmangel wohl etwas auf dem Schlauch und ist mir erst auf der Fahrt zur Arbeit eingefallen, was Du eigentlich gemeint hast. Bei mir ist diese Option seit ewigen Zeiten auf 1 Sheet in Neuer Arbeitsmappe eingestellt, von daher habe ich nicht mehr daran gedacht, dass diese Option standardmäßig auf 3 gesetzt ist.

Habe im obigen Skript eine entsprechende Änderung vorgenommen. D.h. aktuelle Einstellung sichern, auf 1 Sheet einstellen und nach dem Erstellen der neuen Arbeitsmappe wieder auf die vorherige Einstellung zurücksetzen.

Was den Formatierungsfehler angeht, habe ich leider keinen blassen Schimmer, woran das liegen könnte. Meine Excel-Version ist schon ein bisschen älter, aber Tsukis Vorschlag (*.xlsx-Format) könntest Du ja mal testen, also 'Const ExcelMappe = Ping.xls' entsprechend anpassen?

@tsuki

ich glaube wir haben denselben Job nur mit dem Unterschied,
dass ich das Haus morgens schon hundemüde verlasse

Hundemüde zur Arbeit, ist bei mir erst nächste Woche wieder dran, wenn mich mein Wecker gegen 03:45 Uhr aus meinem heißgeliebten Tiefschlaf holt

Gruß und gute Nacht

Dieter

Aloha Dieter,

in der Tat klappt es mit .xlsx ohne Fehlermeldung, allerdings bin ich erst einmal reingefallen

da Ping.xlsx noch nicht existiert hat, aber der Ordner 06 bereits existiert, wurde nach deinem Code keine neue Datei angelegt (das würde ja nur geschehen, wenn der Monats-Ordner noch nicht existiert) und ich bekam logischerweise eine Fehlermeldung.

Naja, Ordner umbenannt und getestet

Sieht bisher gut aus, auch bei einem neuen Tag.

Mal schauen, ob TsukiSan noch Lust und Geduld hat, seinen Code zu optimieren [Danke für die Arbeit bisher], dann könnte ich die alten Dateien ebenso verarbeiten. ^__^

Auf jeden Fall Danke, Dieter, auch für das umfangreiche Kommentieren der Codezeilen.

greetz André

Hallo Andre,

mir persönlich gefällt Dieter seine Variante am besten!

Ich mache meine "Baustelle" soweit fertig, dass du deine anderen Daten noch exportiert bekommst nach Excel.
heisst:
1) Exceldateiname einen Monatsnamen geben, aufgrund des Datums der Dateien
(sind deine Dateien für jeden Monat in einem separaten Ordner?)
2) unnötige Tabellen nachher rauslöschen
3) die Tabellenblätter sortieren
4) alte CSV-Dateien löschen

ich weiss nur nicht, ob ich heute noch dazu komme. Aber ich mache dir das!

Falls ich einen Punkt vergessen habe, bitte melde dich

Viele Grüße

Tsuki

Zitat von @TsukiSan:

(sind deine Dateien für jeden Monat in einem separaten Ordner?)

Um das mal mit einer oben angegebenen Batchzeile zu beantworten:

set "Pfad=D:\Latenz\%Jahr%\%Monat%"

Die bisherigen Dateien liegen im jeweiligen Monats-Ordner.

Gut, mit einer Monatsdatei ist das eigentlich Überfluss geworden ...

So, mit diesem Gedankengang habe ich schnell mal das Skript von Dieter angepasst, sodass jetzt im Jahresordner eine Monats-Exceldatei entsteht, sprich z.B. D:\Latenz\2012\06_Ping.xlsx

greetz André

Hallo André, Hallo Tsuki!

Toll, da tut sich was

Und von mir bekommst Du bei Gelegenheit noch eine Win-Ping-Variante mit Statistik-Auswertung, also ohne das lästige Dos-Fenster

Gruß Dieter

@Dieter

ohne das lästige Dos-Fenster

Damit ich auch noch etwas beitrage: http://blogs.technet.com/b/heyscriptingguy/archive/2004/09/14/why-doesn ...

Grüße
bastla

Aloha Dieter,

hm wie es manchmal so kommt ... ich sitze natürlich lustig an einer XP-Kiste und teste ...

Tja und wie man dann so am Server ist, merkt man, dass gar kein Office dort logischerweise installiert ist *pfeif* - gut, denke ich: Lässte es auf dem 2000er TS laufen, tja läuft auch aber alle Werte sind immer n/v (wenn ich manuell im cmd pinge, bekomme ich die ganz normale Ausgabe).

Ist es möglich, dass etwas im Code unter dem 2000er Server gar nicht lauffähig ist? Wenn ja, muss ich wohl doch extra Office-Paket auf unseren 2003 R2 installieren *hrmpf*.

greetz André

Hallo Andre,

ich sehe, du kämpfst gerade mit anderen Sachen

Ich habe gute als auch interessante Nachrichten für dich.
die Guten zuerst:
Um deine schon erstellten CVS-Dateien nach Excel zu exportieren, habe ich meine "Baustelle" von oben etwas erweitert und auch kommentiert.
Allerdings sind mir 2 Sachen aufgefallen, die ich momentan noch nicht erklären kann. Eventuell helfen uns bastla und Dieter dabei, auf eine Lösung zu kommen. Interessiert mich jetzt auch!
1) Das "Moven" der Tabellen funktioniert mit dem Befehl:

Sheets("Tabelle3").Move Before:=Sheets(1)

unter VBS nicht, aber unter VB6 z.Bsp.
2) Tabellen werden zwar mit IsNumeric erkannt, aber mit

Sheets("Tabelle3").Select
ActiveWindow.SelectedSheets.Delete

z.Bsp.: nicht gelöscht. Sind weiter da und es gibt keinerlei Meldungen.

Hier der aktuelle Script. Bitte mal drüberschauen und die Fehler finden:

Dim Ordner, Pfad, DateiFilter
Dim Dateiliste, MeineDateiNamen
Dim FSO
Dim ObjXls
Dim Trennzeichen

Trennzeichen = ";"  
DateiFilter = "CSV"  

Set FSO = CreateObject("Scripting.FileSystemObject")  

OrdnerAuswaehlen 'Aufruf des Auswahlfensters, welches den Ordner auswählt  
MsgBox "Script startet nach Klick auf OK!"  

DateienEinlesen (Pfad) ' Alle Dateien im ausgewählten Pfad einlesen (sollten CSV-Dateien sein!)  


Private Sub OrdnerAuswaehlen() 'In dieser Sub wird das Auswahlfenster für den Ordner aufgerufen  

AuswahlTitel = "Bitte Ordner auswählen"  
StartOrdner = "17"  
Set Auswahl = CreateObject("Shell.Application").BrowseForFolder(0, AuswahlTitel, 16, StartOrdner)  
If TypeName(Auswahl) = "Nothing" Then  
    MsgBox "Abbruch gewählt!"  
    Wscript.Quit
Else
    Set Ordner = Auswahl.Self
    Pfad = Ordner.Path
End If

End Sub

Private Sub DateienEinlesen(SuchOrdner) ' Hier werden die Dateien eingelesen, die sich im Ordner befinden  
    Set Ordner = FSO.getfolder(SuchOrdner)
    For Each File In Ordner.Files
        Pfadangabe = File.Path
        If LCase(Right(Pfadangabe, 3)) = LCase(DateiFilter) Then 'nur CSV-Dateien werden berücksichtigt  
            SuchDateien = SuchDateien & Pfadangabe & vbCrLf
        End If
    Next
    Set ObjXls = CreateObject("Excel.Application") ' Hier wird ObjXls als Excel-Objekt deklariert  
    ObjXls.Workbooks.Add 'Hier wird eine neue Exceldatei geöffnet.  
    ObjXls.Visible = False 'Damit man die noch nicht sieht, macht man sie unsichtbar  
        a = Split(SuchDateien, vbCrLf) ' Hier die eingelesenen Dateien in ein Array "splitten"  
        For i = 0 To (UBound(a) - 1)
            b = Split(a(i), "\")  
            ObjXls.Sheets.Add
                ObjXls.Sheets("Tabelle" & i + 1).Select ' Hier das Tabellenblatt auswählen  
                tempName = Left(b(UBound(b)), 10) ' Und hier den Namen des Tabellenblattes setzen. Bsp.:2012-05-01 und der Rest wird ignoriert vom Dateinamen  
                MeineDateiNamen = MeineDateiNamen & tempName & vbCrLf 'Brauchen wir zum Sortieren der Tabellen  
                        ObjXls.Sheets("Tabelle" & i + 1).Name = tempName 'Hier Tabellenblatt benennen  
                        ObjXls.Sheets(tempName).Select
            Set MeineDatei = FSO.OpenTextFile(a(i), 1) 'Hier die Datei öffnen, mit den Daten  
            MeineDaten = Split(MeineDatei.ReadAll, vbCrLf) 'Hier alle Daten der Datei in ein Array schreiben (zeilenweise)  
            For j = 0 To UBound(MeineDaten)
                c = Split(MeineDaten(j), Trennzeichen) 'Und hier die einzelnen Zeilen nochmals splitten in ein Array  
                            For k = 0 To (UBound(c)) 'Die jetzt gesplitteten einzelnen Werte in die entsprechenden Zeilen der Exceldatei schreiben  
                         On Error Resume Next
                                    Zeile = Chr(65 + k) & (j + 1) 'Hier benutze ich Character, damit ich in einer Schleife mit Zahlen arbeiten kann.  
                                            ObjXls.Range(Zeile).Value = c(k) 'Heisst: 65=A ; 66=B; 67=C usw., also aus dem ASCII-Code genommen.  
                            Next
            Next
            MeineDatei.Close 'Datei schliessen, sobald sie komplett exportiert worden ist.  
        Next
    DateiMonatsName = Split(b(UBound(b)), "-") 'Hier ermitteln, um welchen Monat es sich handelt. Bsp.: 2012-05-01 -> da ist die 05 interessant und die wird rausgefiltert  
    XlsDateiName = MonthName(DateiMonatsName(1)) & "_" & DateiMonatsName(0) 'und hier ermittle ich den Monatsnamen, also Mai in dem Beispiel  
    ObjXls.ActiveWorkbook.SaveAs Pfad & "\" & XlsDateiName & ".xls" 'Hier die Daten abspeichern in der Exceldatei  
    'Jetzt müssen wir sortieren. Warum das Excel bis 2003 das nicht automatisch macht, weiss ich nicht!  
    temp = Split(MeineDateiNamen, vbCrLf)
    ObjXls.Sheets(temp(0)).Select
    ObjXls.Sheets(temp(0)).Move Before:=ObjXls.Sheets(1) 'IN VB6 funktioniert das, in VBS meckert der Compiler. Wie anders???  
    For i = 1 To ObjXls.Sheets.Count
        tempName = ObjXls.Sheets(i).Name
        tempName = Left(tempName, 1)
        tempName = tempName * 1
        If Not IsNumeric(tempName) Then 'Hier sollten die überflüssigen Tabellen gelöscht werden!  
            t = ObjXls.Sheets(i).Name   ' Warum das auch nicht geht, habe ich noch nicht ergründet.  
            ObjXls.Sheets(t).Select
            ObjXls.SelectedSheets.Delete
        End If
        ObjXls.Sheets(temp(i)).Select
        ObjXls.Sheets(temp(i)).Move After:=ObjXls.Sheets(i)
    Next
    ObjXls.ActiveWorkbook.Close 'Und hier die erstellte Exceldatei schliessen.  
    
    MsgBox MeineDateiNamen 'Fertig!  
End Sub

So long,

Tsuki

Ps.: wir kriegen das hier schon geschaukelt

@andre,

was sehr hilfreich ist, ist das Notpad++
Da wird es übersichtlicher, wenn man die .VBS-Datei damit öffnet

Gruss
Tsuki

[Frau-Mit-Nur-Einer-Brust]
Wenn du möchtest, kompiliere ich dir die VB6-Version als asuzuführende exe-Datei. Damit kannst du zumindest erst einmal deine alten Dateien einlesen.
Das Löschen der bereits eingelesenen Dateien kommt noch. Dieses Feature hebe ich mir auf bis zum Schluss, bis ales andere funktioniert.
Weil gelöscht ist schnell

[/Frau-Mit-Nur-Einer-Brust]

Ps.: Frau-Mit-Nur-Einer-Brust = EDIT

Hallo Tsuki!

Versuche es mal so

    ObjXls.Sheets(temp(0)).Move ObjXls.ActiveWorkbook.Sheets(1)

bzw so

        ObjXls.Sheets(temp(i)).Move ,ObjXls.ActiveVorkbook.Sheets(i)

Das jeweilige "Select" davor sollte übrigens nicht nötig sein ...

[Edit] steht jetzt unten [/Edit]

Grüße
bastla

@bastla,

auf dich ist Verlass

Funktioniert, mit einer ganz kleinen Anpassung

ObjXls.Sheets(temp(0)).Move ,ObjXls.ActiveWorkbook.Sheets(1)

und

ObjXls.Sheets(temp(i)).Move ,ObjXls.ActiveWorkbook.Sheets(i + 1)

und das -Select benötigt man tatsächlich nicht.

Wie du das immer machst

Wie bekommen wir die überflüssigen Tabellen gelöscht?
Zeilen 78 und 79 tangieren dieses Programm peripher

Danke und viele Grüße

Tsuki

hier nochmal als VBS:

Dim Ordner, Pfad, DateiFilter
Dim Dateiliste, MeineDateiNamen
Dim FSO
Dim ObjXls
Dim Trennzeichen

Trennzeichen = ";"  
DateiFilter = "CSV"  

Set FSO = CreateObject("Scripting.FileSystemObject")  

OrdnerAuswaehlen 'Aufruf des Auswahlfensters, welches den Ordner auswählt  
MsgBox "Script startet nach Klick auf OK!"  

DateienEinlesen (Pfad) ' Alle Dateien im ausgewählten Pfad einlesen (sollten CSV-Dateien sein!)  


Private Sub OrdnerAuswaehlen() 'In dieser Sub wird das Auswahlfenster für den Ordner aufgerufen  

AuswahlTitel = "Bitte Ordner auswählen"  
StartOrdner = "17"  
Set Auswahl = CreateObject("Shell.Application").BrowseForFolder(0, AuswahlTitel, 16, StartOrdner)  
If TypeName(Auswahl) = "Nothing" Then  
    MsgBox "Abbruch gewählt!"  
    Wscript.Quit
Else
    Set Ordner = Auswahl.Self
    Pfad = Ordner.Path
End If

End Sub

Private Sub DateienEinlesen(SuchOrdner) ' Hier werden die Dateien eingelesen, die sich im Ordner befinden  
    Set Ordner = FSO.getfolder(SuchOrdner)
    For Each File In Ordner.Files
        Pfadangabe = File.Path
        If LCase(Right(Pfadangabe, 3)) = LCase(DateiFilter) Then 'nur CSV-Dateien werden berücksichtigt  
            SuchDateien = SuchDateien & Pfadangabe & vbCrLf
        End If
    Next
    Set ObjXls = CreateObject("Excel.Application") ' Hier wird ObjXls als Excel-Objekt deklariert  
    ObjXls.Workbooks.Add 'Hier wird eine neue Exceldatei geöffnet.  
    ObjXls.Visible = False 'Damit man die noch nicht sieht, macht man sie unsichtbar  
        a = Split(SuchDateien, vbCrLf) ' Hier die eingelesenen Dateien in ein Array "splitten"  
        For i = 0 To (UBound(a) - 1)
            b = Split(a(i), "\")  
            ObjXls.Sheets.Add
                ObjXls.Sheets("Tabelle" & i + 1).Select ' Hier das Tabellenblatt auswählen  
                tempName = Left(b(UBound(b)), 10) ' Und hier den Namen des Tabellenblattes setzen. Bsp.:2012-05-01 und der Rest wird ignoriert vom Dateinamen  
                MeineDateiNamen = MeineDateiNamen & tempName & vbCrLf 'Brauchen wir zum Sortieren der Tabellen  
                        ObjXls.Sheets("Tabelle" & i + 1).Name = tempName 'Hier Tabellenblatt benennen  
                        ObjXls.Sheets(tempName).Select
            Set MeineDatei = FSO.OpenTextFile(a(i), 1) 'Hier die Datei öffnen, mit den Daten  
            MeineDaten = Split(MeineDatei.ReadAll, vbCrLf) 'Hier alle Daten der Datei in ein Array schreiben (zeilenweise)  
            For j = 0 To UBound(MeineDaten)
                c = Split(MeineDaten(j), Trennzeichen) 'Und hier die einzelnen Zeilen nochmals splitten in ein Array  
                            For k = 0 To (UBound(c)) 'Die jetzt gesplitteten einzelnen Werte in die entsprechenden Zeilen der Exceldatei schreiben  
                         On Error Resume Next
                                    Zeile = Chr(65 + k) & (j + 1) 'Hier benutze ich Character, damit ich in einer Schleife mit Zahlen arbeiten kann.  
                                            ObjXls.Range(Zeile).Value = c(k) 'Heisst: 65=A ; 66=B; 67=C usw., also aus dem ASCII-Code genommen.  
                            Next
            Next
            MeineDatei.Close 'Datei schliessen, sobald sie komplett exportiert worden ist.  
        Next
    DateiMonatsName = Split(b(UBound(b)), "-") 'Hier ermitteln, um welchen Monat es sich handelt. Bsp.: 2012-05-01 -> da ist die 05 interessant und die wird rausgefiltert  
    XlsDateiName = MonthName(DateiMonatsName(1)) & "_" & DateiMonatsName(0) 'und hier ermittle ich den Monatsnamen, also Mai in dem Beispiel  
    ObjXls.ActiveWorkbook.SaveAs Pfad & "\" & XlsDateiName & ".xls" 'Hier die Daten abspeichern in der Exceldatei  
    'Jetzt müssen wir sortieren. Warum das Excel bis 2003 das nicht automatisch macht, weiss ich nicht!  
    temp = Split(MeineDateiNamen, vbCrLf)
	'IN VB6 funktioniert das, in VBS meckert der Compiler. Wie anders???  
    ObjXls.Sheets(temp(0)).Move ,ObjXls.ActiveWorkbook.Sheets(1)
	For i = 1 To ObjXls.Sheets.Count
        tempName = ObjXls.Sheets(i).Name
        tempName = Left(tempName, 1)
        tempName = tempName * 1
        If Not IsNumeric(tempName) Then 'Hier sollten die überflüssigen Tabellen gelöscht werden!  
            t = ObjXls.Sheets(i).Name
            ObjXls.Sheets(i).Delete
        End If
		ObjXls.Sheets(temp(i)).Move ,ObjXls.ActiveWorkbook.Sheets(i + 1)
    Next
    ObjXls.ActiveWorkbook.Close 'Und hier die erstellte Exceldatei schliessen.  
    
    MsgBox MeineDateiNamen 'Fertig!  
End Sub

Gruss
Tsuki

[Edit]
allerbesten Dank an bastla!
ich habe es angepasst und noch etwas abgeändert. Jetzt tut er's, also sortieren und überflüssige Tabellen löschen. Es nervt zwar etwas, dass man da noch 3 oder 4 Mal OK drücken muss, aber ich denke, dass ist für Andre im Moment akzeptabel

Das löschen der CSV-Dateien erst, wenn soweit der Export funktioniert, wie ihn Andre haben möchte.
/Edit]

Hallo Tsuki!

Das Tabellen-Löschen würde ich nicht unbedingt während des Sortierens machen - daher nachträglich etwa so:

    For Each Sheet In ObjXls.Sheets
        If Not IsNumeric(Sheet.Name) Then Sheet.Delete
    Next

Noch ein Hinweis: Mit

ObjXls.ActiveWorkbook.SaveAs Pfad & "\" & XlsDateiName 'Hier die Daten abspeichern in der Exceldatei

- also ohne Angabe des Dateityps - wird automatisch im Standard-Excel-Format (.xls oder .xlsx) gespeichert ...

Grüße
bastla

@bastla,

ich weiss, aber er macht's in einem Rutsch gleich mit und jetzt funktioniert es. Habe es getestet und oben korrigiert.
Schau doch bitte nochmal drüber.

Allerbesten Dank an dich!!!!!!

Gruss
Tsuki

@ bastla,

was ich noch erwähnen wollte - und warum ich in Zeile 74

tempName = tempName * 1

gesetzt habe ist folgender Grund:
Der Compiler interpretiert

    For Each Sheet In ObjXls.Sheets
        If Not IsNumeric(Sheet.Name) Then Sheet.Delete
    Next

alles als Strings, da die Dinger mit "" eingelesen werden.
Mit meiner Variante lese ich den ersten linken String aus und multipliziere ihn mit 1. Wenn es kein Buchstabe ist, dann wird da eine Ziffer draus, also numerisch

Aber das ist sicher nichts Neues für dich.

Soweit macht Andres Frage riesen Spass

Gruss
Tsuki

Hallo Tsuki!

tempName = tempName * 1

ist aber nicht nötig, weil ja "IsNumeric()" dafür gedacht ist, Strings zu prüfen ...

Mein Ansatz war etwas verkürzt (es soll ja nur das erste Zeichen des Namens geprüft werden), daher:

    For Each Sheet In ObjXls.Sheets
        If Not IsNumeric(Left(Sheet.Name,1)) Then Sheet.Delete
    Next

BTW: Ich sehe in Deinem Code keinen Sortier-Algorithmus - soferne also nicht die Dateien in der richtigen Reihenfolge erstellt (was bei den Originaldateien aber eigentlich der Fall sein müsste) und daher ohnehin so eingelesen wurden, wird die Reihenfolge der Tabellenblätter nicht stimmen ...

Grüße
bastla

Hallo bastla,

das IsNumeric behandelt ohne diese Zeile 74 alles als einen String bei mir und somit nicht als numerisch. Nur dieser kleine Trick half mir dabei.
WinXp Eng SP3 und Office 2000 Prof, bzw. Office 2003 SP1.
Warum er das macht, weiss ich nicht. In VB6 getestet liest er es auch als String ein und es kümmert "ihn" nicht, ob 2 eine Ziffer oder T ein Buchstabe ist. Ist für "ihn" hier alles gleich, nämlich nichtnumerisch. Naja, man kann das aber so abfangen

Mit dem Multiplizieren schiesst man endgültig irgendwleche Gänsefüsschen ab

Einen Sortieralgorithmus gibt es in meinem Code nicht. Das ist richtig. Bisher werden die Dateien in der Reihenfolge eingelesen, wie es ### zur Verfügung stellt. Wenn da die Reihenfolge nicht mehr stimmt, weil eventuell nach Datum oder sonst etwas sortiert wird, dann müssten wir dem ganzen noch einen Bubblesort spendieren. Ich glaube, dass müssen wir aber gar nicht.
Mit dem bisherigen Code und dem Sortieren in den Zeilen 70 bis 81 funktioniert es bei mir prächtig. Ich kann nur kein Office 2007 testen, weil "No Have"

Es ist immer wieder schön, was man hier alles dazulernt. Danke bastla, danke Dieter!

Mal sehen, was bei Andre rauskommt.

Gruss
Tsuki

[Edit]
### hat die wunderschöne Seite wieder zensiert

Ich wollte ja Whinntoofff nicht schreiben

[/Edit]

Hallo Andre,

ich weiss nicht, wie ich morgen Zeit habe. Hier der code,
der folgendes macht:
1) Ordner auswählen
2) Alle dort befindlichen CVS-Dateien einlesen
3) alles was relevant ist nach Excel exportieren (ab 2007 ungetestet!)
4) Überflüssige Tabellen löschen (muss man ggf. mit OK bestätigen)
5) Dann alles soweit sortieren im neuen Excelblatt
6) alle CSV-Dateien gnadenlos löschen( hier bitte Obacht!)

Gruss
Tsuki

Dim Ordner, Pfad, DateiFilter
Dim Dateiliste, MeineDateiNamen
Dim FSO, SuchDateien
Dim ObjXls
Dim Trennzeichen

Trennzeichen = ";"  
DateiFilter = "CSV"  

Set FSO = CreateObject("Scripting.FileSystemObject")  

OrdnerAuswaehlen 'Aufruf des Auswahlfensters, welches den Ordner auswählt  
MsgBox "Script startet nach Klick auf OK!"  

DateienEinlesen (Pfad) ' Alle Dateien im ausgewählten Pfad einlesen (sollten CSV-Dateien sein!)  

Set FSO = Nothing

Private Sub OrdnerAuswaehlen() 'In dieser Sub wird das Auswahlfenster für den Ordner aufgerufen  

AuswahlTitel = "Bitte Ordner auswählen"  
StartOrdner = "17"  
Set Auswahl = CreateObject("Shell.Application").BrowseForFolder(0, AuswahlTitel, 16, StartOrdner)  
If TypeName(Auswahl) = "Nothing" Then  
    MsgBox "Abbruch gewählt!"  
    Wscript.Quit
Else
    Set Ordner = Auswahl.Self
    Pfad = Ordner.Path
End If

End Sub

Private Sub DateienEinlesen(SuchOrdner) ' Hier werden die Dateien eingelesen, die sich im Ordner befinden  
    Set Ordner = FSO.getfolder(SuchOrdner)
    For Each File In Ordner.Files
        Pfadangabe = File.Path
        If LCase(Right(Pfadangabe, 3)) = LCase(DateiFilter) Then 'nur CSV-Dateien werden berücksichtigt  
            SuchDateien = SuchDateien & Pfadangabe & vbCrLf
        End If
    Next
    Set ObjXls = CreateObject("Excel.Application") ' Hier wird ObjXls als Excel-Objekt deklariert  
    ObjXls.Workbooks.Add 'Hier wird eine neue Exceldatei geöffnet.  
    ObjXls.Visible = False 'Damit man die noch nicht sieht, macht man sie unsichtbar  
        a = Split(SuchDateien, vbCrLf) ' Hier die eingelesenen Dateien in ein Array "splitten"  
        For i = 0 To (UBound(a) - 1)
            b = Split(a(i), "\")  
            ObjXls.Sheets.Add
                ObjXls.Sheets("Tabelle" & i + 1).Select ' Hier das Tabellenblatt auswählen  
                tempName = Left(b(UBound(b)), 10) ' Und hier den Namen des Tabellenblattes setzen. Bsp.:2012-05-01 und der Rest wird ignoriert vom Dateinamen  
                MeineDateiNamen = MeineDateiNamen & tempName & vbCrLf 'Brauchen wir zum Sortieren der Tabellen  
                        ObjXls.Sheets("Tabelle" & i + 1).Name = tempName 'Hier Tabellenblatt benennen  
                        ObjXls.Sheets(tempName).Select
            Set MeineDatei = FSO.OpenTextFile(a(i), 1) 'Hier die Datei öffnen, mit den Daten  
            MeineDaten = Split(MeineDatei.ReadAll, vbCrLf) 'Hier alle Daten der Datei in ein Array schreiben (zeilenweise)  
            For j = 0 To UBound(MeineDaten)
                c = Split(MeineDaten(j), Trennzeichen) 'Und hier die einzelnen Zeilen nochmals splitten in ein Array  
                            For k = 0 To (UBound(c)) 'Die jetzt gesplitteten einzelnen Werte in die entsprechenden Zeilen der Exceldatei schreiben  
                         On Error Resume Next
                                    Zeile = Chr(65 + k) & (j + 1) 'Hier benutze ich Character, damit ich in einer Schleife mit Zahlen arbeiten kann.  
                                            ObjXls.Range(Zeile).Value = c(k) 'Heisst: 65=A ; 66=B; 67=C usw., also aus dem ASCII-Code genommen.  
                            Next
            Next
            MeineDatei.Close 'Datei schliessen, sobald sie komplett exportiert worden ist.  
        Next
    DateiMonatsName = Split(b(UBound(b)), "-") 'Hier ermitteln, um welchen Monat es sich handelt. Bsp.: 2012-05-01 -> da ist die 05 interessant und die wird rausgefiltert  
    XlsDateiName = MonthName(DateiMonatsName(1)) & "_" & DateiMonatsName(0) 'und hier ermittle ich den Monatsnamen, also Mai in dem Beispiel  
    ObjXls.ActiveWorkbook.SaveAs Pfad & "\" & XlsDateiName & ".xls" 'Hier die Daten abspeichern in der Exceldatei  
    'Jetzt müssen wir sortieren. Warum das Excel bis 2003 das nicht automatisch macht, weiss ich nicht!  
    temp = Split(MeineDateiNamen, vbCrLf)
    ObjXls.Sheets(temp(0)).Move ,ObjXls.ActiveWorkbook.Sheets(1)
	For i = 1 To ObjXls.Sheets.Count
        tempName = ObjXls.Sheets(i).Name
        tempName = Left(tempName, 1)
        tempName = tempName * 1
        If Not IsNumeric(tempName) Then 'Hier sollten die überflüssigen Tabellen gelöscht werden!  
            t = ObjXls.Sheets(i).Name
            ObjXls.Sheets(i).Delete
        End If
		ObjXls.Sheets(temp(i)).Move ,ObjXls.ActiveWorkbook.Sheets(i + 1)
    Next
    ObjXls.ActiveWorkbook.Close 'Und hier die erstellte Exceldatei schliessen.  
    
	DateienLoeschen 'Hier das Löschen aufrufen  
    MsgBox "Aufgaben ausgeführt!"  
	
End Sub

Private Sub DateienLoeschen()
a = Split(SuchDateien,vbcrlf)
For i = 0 to(Ubound(a)-1)
	FSO.deleteFile (a(i))
Next
End Sub

Hallo Sky!

Test mal mit diesem Skript, ob Du eine Ping-Antwort erhälst:

    Option Explicit

    Const PingCount = 10


    Dim objWin, objExec, objPing, arrReply, intMin, intMax, intMit, intLost, i
    
    Redim arrReply(PingCount - 1)	    

    Set objWin = GetObject("winmgmts:{impersonationLevel=impersonate}")  
    
    intLost = 0
    
    For i = 0 To PingCount - 1
        Set objExec = objWin.ExecQuery("select * from Win32_PingStatus where address = 'google.de'")  
        
        For Each objPing In objExec
            If objPing.StatusCode = 0 Then
                arrReply(i) = objPing.ResponseTime
            Else
                arrReply(i) = 0
                intLost = intLost + 1
            End If
        Next
    Next

    If intLost = PingCount Then
        MsgBox "Keine Antwort!"  
    Else
        MsgBox "Antworten = " & PingCount - intLost & ", Verloren = " & intLost  
    End If

wobei eine MsgBox zu testzwecken eine entsprechende Meldung ausgibt

@all
Ihr wart in der Zwischenzeit ja ganz schön fleißig

Gruß Dieter

Aloha ihr drei,

@tsuki ich nutze Proton das genügt mir.

Ihr könnt euch Zeit lassen, zum Basteln, ich bin erst einmal krank geschrieben - Verdacht auf Blinddarmentzündung, daher komme ich sowieso nicht zum Testen unter Realbedingungen ...

greetz André

P.S.:@Dieter, mein Nickname hat nichts mit dem Himmel zu tun

Hallo Andre,

na erst einmal gute Besserung!

Proton geht natürlich auch. Wenn man's nur mit dem Notepad aufmacht, sieht's nicht so schön aus.

@Dieter,

danke, danke! Wir waren alle fleissig

Nur das Ergebnis zählt.

Gruss und gute Besserung,

Tsuki

Hallo André!

Auch von mir gute Besserung!

Blindarmentzündung, tut das weh?

P.S.:@Dieter, mein Nickname hat nichts mit dem Himmel zu tun

Aber, Du hast doch Flügel

@tsuki

danke, danke! Wir waren alle fleissig Nur das Ergebnis zählt.

Jepp, da gebe ich Dir vollkommen Recht

Gruß Dieter

Hallo Skye!

Auf dass sich der Verdacht nicht bestätigen möge ...

Grüße
bastla

Hallo André!

Hier - wie versprochen - die Win-Ping-Version:

    Option Explicit

    Const PingCount = 20    'Anzahl Pings  

    Const PathStart = "D:\Latenz"  

    Const ExcelMappe = "_Ping.xlsx"  

    Const ExcelHeader = "Uhrzeit,Min [ms],Max [ms],Mit [ms],Verlust [%]"  

    Const ErrMsg1 = "Pfad nicht gefunden:"  

    Const xlUp = -4162
    Const xlRight = -4152
    Const xlCenter = -4108
   

    Dim objWin, objExec, objPing, objFso, objExcelApp, objExcelSheet, arrReply, arrValues
    Dim strDate, strTime, strYear, strMonth, strDay, strStdOut, strPathYear, strPathMonth
    Dim strPathExcelMappe, intNewSheets, intNextLine, intMin, intMax, intMit, intLost, i
    
    ReDim arrReply(PingCount - 1)                           'Array-Größe für Antwort entspricht Ping-Anzahl  
    
    strTime = FormatDateTime(Time, vbShortTime)             'Format HH:MM  
    
    Set objWin = GetObject("winmgmts:{impersonationLevel=impersonate}") 'Object Win-System  
    
    intLost = 0                                             'Init Zähler Verloren = 0  
    
    For i = 0 To PingCount - 1                              'Schleife entsprechend Ping-Anzahl  
        Set objExec = objWin.ExecQuery("Select * From Win32_PingStatus Where Address = 'google.de'") 'Ping senden  
        
        For Each objPing In objExec                         'Ping-Object-Zuweisung  
            If objPing.StatusCode = 0 Then                  'Test Ping-Status (0 = OK)  
                arrReply(i) = objPing.ResponseTime          'Zeitwert in Array sichern  
            Else                                            'Verloren  
                arrReply(i) = 0                             'Zeitwert 0 in Array sichern  
                intLost = intLost + 1                       'Zähler Verloren + 1  
            End If
        Next
    Next                                                    'Nächsten Ping senden  
 
    strYear = Year(Date)                                    'Format YYYY  
    strMonth = Right("0" & Month(Date), 2)                  'Format MM  
    strDay = CStr(Day(Date))                                'Format #D)  
    
    strDate = strYear & "-" & strMonth & "-" & Right("0" & strDay, 2)   'Format YYYY-MM-DD  
    
    strPathYear = PathStart & "\" & strYear                 'Path "D:\Latenz\Jahr"  
    strPathExcelMappe = strPathYear & "\" & strMonth & ExcelMappe   'Path "D:\Latenz\Jahr\Monat_ExcelMappe"  
    
    Set objFso = CreateObject("Scripting.FileSystemObject") 'Object Dateioperationen  

    If objFso.FolderExists(PathStart) Then                  'Test ob der PathStart existiert  
        If objFso.FolderExists(strPathYear) = False Then    'Test ob der Pfad mit Jahr nicht existiert  
            objFso.CreateFolder strPathYear                 'Pfad mit Jahr erstellen  
        End If
        
        Set objExcelApp = CreateObject("Excel.Application") 'Object ExcelApplication  
        
        If intLost = PingCount Then                         'Test ob alle Pings Verloren sind  
            arrValues = Array(strTime, "n/v", "n/v", "n/v", "n/v")  'Verbindungsfehler (Zeit,Min,Max,Mittel,Verlust)  
        Else
            With objExcelApp.WorksheetFunction              'Excel Berechnungs-Funktionen nutzen  
                If intLost = 0 Then                         'Test Verloren = 0 (Array ohne 0-Werte)  
                    intMin = .Small(arrReply, 1)            'Min-Wert = Kleinster Wert in Array  
                Else                                        'Wenn Verloren > 0 (Array mit 0-Werte)  
                    intMin = .Small(arrReply, 2)            'Min-Wert = 2. Kleinster Wert in Array  
                    intLost = Round(intLost / PingCount * 100, 0)   'Verlust in Prozent (auf/abgerundet)  
                End If
                
                intMax = .Max(arrReply)                     'Max-Wert  
                intMit = Round(.Average(arrReply), 0)       'Mittelwert (auf/abgerundet)  
            End With
            arrValues = Array(strTime, intMin, intMax, intMit, intLost)  'Werte (Zeit,Min,Max,Mittel,Verlust)  
        End If
   
        If objFso.FileExists(strPathExcelMappe) Then        'Test ob Excel-Datei vorhanden ist  
            With objExcelApp.Workbooks.Open(strPathExcelMappe, , , , , "Write") 'Excel-Datei öffnen (Schreibberechtigt)  
                Set objExcelSheet = Nothing                 'Object Excel-Sheet = Nothing  
                    
                On Error Resume Next                        'Fehlerbehandlung Aus  
                Set objExcelSheet = .Sheets(strDay)         'Object Excel-Sheet = Tag?  
                On Error GoTo 0                             'Fehlerbehandlung Ein  
                    
                If objExcelSheet Is Nothing Then            'Test Excel-Sheet Tag existiert nicht  
                    Set objExcelSheet = .Sheets.Add(, .Sheets(.Sheets.Count))
                    Call SheetInit(objExcelSheet, strDay, arrValues)
                Else    'Wenn Sheet (Tag) bereits existiert  
                    With objExcelSheet
                        intNextLine = .Cells(.Rows.Count, "A").End(xlUp).Row + 1  'Nächste freie Zeile  
                       .Cells(intNextLine, "A").Resize(1, 5).Value = arrValues    'Werte einfügen  
                    End With
                End If
               .Close True  'Excel-Mappe speichern und schließen  
            End With
        Else
            With objExcelApp
                intNewSheets = .SheetsInNewWorkbook                 'Option Anzahl Sheets sichern  
               .SheetsInNewWorkbook = 1                             'Option Anzahl Sheets = 1  

                With .Workbooks.Add                                 'Neue Excel-Mappe erstellen  
                    Call SheetInit(.Sheets(1), strDay, arrValues)
                   .SaveAs strPathExcelMappe, , , "Write"           'Excel-Mappe mit Schreibkennwort speichern  
                   .Close False                                     'Excel-Mappe schließen  
                End With
            
               .SheetsInNewWorkbook = intNewSheets                  'Option Anzahl Sheets wiederherstellen  
            End With
        End If
        
        objExcelApp.Quit                                            'Excel-Application schließen  
    Else
        MsgBox ErrMsg1 & vbCr & vbCr & PathStart, vbExclamation, "Fehler..."  
    End If


    Private Sub SheetInit(ByRef Sheet, ByRef SheetName, ByRef Values)
        With Sheet                                          'Sheet("TabelleX")  
           .Name = SheetName                                'Sheet-Name = Tag X  
           .Range("A:E").HorizontalAlignment = xlRight      'Spalten rechtsbündig  
            
            With .Range("A1").Resize(1, 5)                  'Zell-Bereich A1:E1 festlegen  
                .Value = Split(ExcelHeader, ",")            'Überschrift einfügen  
                .Font.Bold = True                           'Fett-Schrift festlegen  
                .HorizontalAlignment = xlCenter             'Überschrift zentrieren  
            End With
                    
           .Range("A2").Resize(1, 5).Value = Values         'Werte in Zeile 2 einfügen  
        End With
    End Sub

wobei, Deine Anpassung (alle Mappen im Jahres-Ordner) ebenfalls berücksichtigt wurde

Gruß Dieter

PS.
Falls Dir die Ping-Folge zu schnell sein sollte, dann kannst Du in der Ping-Schleife noch diese Codezeile einfügen

WScript.Sleep 500  'Pause in Millisekunden

Und falls sich jemand wundert, warum die Antiviren-Software trotz akueller Updates mit der Meldung 'Datenbanken und Programm-Module veraltet' nervt, dann liegt das daran, dass Ihr - wie ich - vergessen habt, nach dem Testen das Datum wieder richtig einzustellen

Zitat von @bastla:

Auf dass sich der Verdacht nicht bestätigen möge ...

Aloha bastla,

glücklicherweise scheint es, als habe sich der Verdacht nicht bestätigt, dennoch ist die Ursache unklar und die Symptome nicht weg ... also noch eine Weile krankgeschrieben => das Testen der Lösungen zieht sich also noch ;)

Gruß an alle und Danke für die Genesungswünsche,

André

Aloha zusammen,

*sigh* der Tisch ist voll, so voll ... ich hoffe, ich komme noch diese Woche dazu, das Thema hier abzuschließen, momentan hab' ich nicht einmal die Luft, mich hier überhaupt groß anzumelden am Tag ^__^

und ich hoffe, die Infektion bekommt keinen erneuten Rückfall ...

greetz André

Multiposts ftw, ich hasse das Jahr 2012 - bin wieder krank geschrieben ... und versucht mal einer in der Urlaubszeit kurzfristig einen Termin for Sono zu kriegen, haha ~.~

Soooo also, nu gehen wir doch mal ran an den Speck:

Dieters letzte Ausführung bringt auf dem TS2000 leider folgendes:

Zeile:	33
Zeichen:	9
Fehler: 0x80041010
Code:	80041010
Quelle:		(null)

Er mag also das For Each nicht(?)

greetz André

Hallo André!

Teste mal mit diesem Skript, ob Du eine entsprechende Fehlermeldung bekommst:

    Option Explicit

    Const PingCount = 10


    Dim objWin, objExec, objPing, arrReply, intMin, intMax, intMit, intLost, i
    
    ReDim arrReply(PingCount - 1)

    On Error Resume Next
    Set objWin = Nothing
    Set objWin = GetObject("winmgmts:{impersonationLevel=impersonate}")  
    
    If objWin Is Nothing Then
        MsgBox "Objekterstellung (objWin) nicht möglich!":  WScript.Quit 1  
    End If
    
    intLost = 0
       
    For i = 0 To PingCount - 1
        Set objExec = Nothing
        Set objExec = objWin.ExecQuery("select * from Win32_PingStatus where address = 'google.de'")  
        
        If objExec Is Nothing Then
            MsgBox "Objekterstellung (objExec) nicht möglich!":  WScript.Quit 1  
        End If
        
        For Each objPing In objExec
            If objPing.StatusCode = 0 Then
                arrReply(i) = objPing.ResponseTime
            Else
                arrReply(i) = 0
                intLost = intLost + 1
            End If
        Next
    Next

    If intLost = PingCount Then
        MsgBox "Keine Antwort!"  
    Else
        MsgBox "Antworten = " & PingCount - intLost & ", Verloren = " & intLost  
    End If

Gruß Dieter

Aloha Dieter,

Antworten = 10, Verloren = 0

greetz André

Hallo André!

Muss gestehen, dass ich dieses Ergebnis eigentlich nicht erwartet habe

, zumal ich zum anderen Skript keinen Unterschied feststellen kann.

Und was passiert, wenn Du mal die Codezeile 'On Error Resume Next' mit einem Kommentarzeichen (') auskommentierst?

Gruß Dieter

Zitat von @76109:

Und was passiert, wenn Du mal die Codezeile 'On Error Resume Next' mit einem Kommentarzeichen (') auskommentierst?

Macht null Komma gar keinen Unterschied

Hallo nochmal!

Also, ich habe diesen Code (didi1954 schreibt am 07.06.2012 um 10:34:41 Uhr) nochmal bei mir getestet und der funktioniert einwandfrei?

Gruß Dieter

... hm, dann hat unser TS doch einen weg, die Vermutung hatte ich eh schon länger ...

Hallo André!

... hm, dann hat unser TS doch einen weg, die Vermutung hatte ich eh schon länger ...

Das kann ich leider nicht beurteilen

Du könntest den ganzen Code-Block auch einfach mal austauschen, eventuell hat sich da irgendetwas eingeschlichen, was da nicht hingehört? Das hatte ich auch schonmal

Gruß Dieter

PS. Gegebenenfalls auch mal woanders (Zuhause?) testen...

Frage Entwicklung Batch, Shell

Mehr von Skyemugen

Unsichere Software für sicheren Zugang zum Flughafen-NetzwerkSkyemugen - 11 Kommentare

Szenario Identischer Drucker mit abweichendem Treiber funktioniert nicht auf ServerSkyemugen - 3 Kommentare

DeutschlandLAN Connect IP vs DeutschlandLAN IP Voice-Data FiberSkyemugen - 19 Kommentare

EMails revisionssicher archivierenSkyemugen - 11 Kommentare

Heiß diskutiert