Per vbs von einem XLS Worksheet Spalten sortieren und Kopieren

[Refnex 10]

Hi @ all

 

hab da mal so ne keine frage und hoffe es kann mir jemand helfen.

Ich muss gerade nen Script basteln was Auf dem Server via Schedule Job ausgeführt wird und immer in einer csv die Daten von den Festplatten (Gesamt, Belegt) einträgt und dann in ein weiteres File dumpt zur weiter Bearbeitung.

Dieses file soll eine XLS sein und die dort übernommenen Server anhand ihres namens immer in ein neues Tabellen Blatt eingefügt werden.

 

das zusammen Sammeln und das Speichen bzw. Convertiren in XLS bekomme ich noch hin aber mit der Sortierung tu ich mir schwer

 

Hier mal der Source das ihr wisst was das dingens Treibt

 

'------------------------------------------
' Ermittlung des Computernamens
Set MyFiles	= CreateObject("Scripting.FileSystemObject")
Set wshnet = CreateObject("WScript.Network")
Set wshshell = CreateObject("WScript.Shell")
Dim strComputer
strComputer = wshnet.Computername
'Auslesen der Windows-Hardwareinformationen


' Um weitere laufwerke hinzu zu fügen verwenden Sie folgenden String
' "   if objItem.Caption = "(Laufwerk buchstabe):" then (festplatten ausgabe variable)= objItem.Caption & " ; " & Round(objItem.FreeSpace /1024 /1024 /1024, 2) & " ; " & Round(objItem.Size /1024 /1024 /1024,2) & " ; " & " GByte"
' achten sie Bitte darauf das sie auch die ausgabe in Zeile 

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk",,48)
For Each objItem in colItems
if objItem.Caption = "C:" then festplatteC= objItem.Caption & "; " & Round(objItem.FreeSpace /1024 /1024 /1024, 2) & " ; " & Round(objItem.Size /1024 /1024 /1024,2) & ";" & " GByte"
if objItem.Caption = "D:" then festplatteD= objItem.Caption & "; " & Round(objItem.FreeSpace /1024 /1024 /1024, 2) & " ; " & Round(objItem.Size /1024 /1024 /1024,2) & ";" & " GByte"
Next

' Datum und Uhrzeit ermitteln
Dim ausgabe
Dim datum
Dim zeit

set ausgabe = WScript.CreateObject("WScript.Shell")
datum = Date
zeit = Time
timestamp = datum & " "  & zeit



'===================================================================================
' FOR DEBUGING
'===================================================================================

' Messagebox mit den abgefragten Werten erzeugen und anzeigen lfür Debug
'Meldung = "Folgende Daten wurden ermittelt:" & VbCr & VbCr


' ACHTUNG wie oben beschreiben bei zugefügtem laufwerk bitte ausgabe anpassen 
'Example "Add "Festplatte C: " & festplatteC"

'Add "Festplatte C: " & festplatteC
'Add "Festplatte D: " & festplatteD
'Add "Timestamp: " & timestamp

'MsgBox Meldung,,"Ergebnis:"

'====================================================================================

Sub Add(text)
   ' fügt Text hinzu
  Meldung = strComputer & Meldung & text & vbCrLf
End Sub

'===================================================================================
' FOR DEBUGING
'===================================================================================
'Frage_Logfile = "Sollen diese Angaben in das Logfile eingetragen werden?"
'antwort = MsgBox(Frage_Logfile, vbYesNo + vbQuestion,"Logeintrag erzeugen?")
'if antwort = vbNo then
 ' MsgBox "Kein Logeintrag geschrieben.",vbExclamation,"Abbruch"
  'WScript.Quit
'end if
'======================================================================================


' Erzeugung des Strings für die Logdatei

Logeintrag = timestamp & ";" & strComputer & ";"  & festplatteC & ";" & festplatteD

' Deklaration der Variablen für das Logfile
filename = "d:\HW-Infos.csv" ' <---- Hier den Pfad und den Dateinamen des zu schreibenden Logfiles eintragen


Const ForAppending = 8
Set fs = CreateObject("Scripting.FileSystemObject")

' Logdatei zum Anhängen der Eintrage laden
Set textstream = fs.OpenTextFile(filename, ForAppending, True)
ok = (Err.number = 0)
If ok Then
   On Error Goto 0
   textstream.WriteLine Logeintrag
   textstream.Close'
   Logeintrag_OK = "Folgender Logeintrag wurde erzeugt:" & vbcr & vbcr & Logeintrag
'   MsgBox Logeintrag_OK,,"Logeintragung erfolgreich:"
Else
   MsgBox "Fehler: " & Err.Description
End If

'===========================================================================================================
' Convert CSV to XLS
'===========================================================================================================

Dim sInFile
sOutPathDefault = "d:\KonvertierteCSV" 'Angabe des Default-Zielpfades ohne abschließenden "\"

sInFile = filename

Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(sInFile) Then
	WScript.Echo sInFile & " nicht gefunden!"
	WScript.Quit(1)	
Else 'Pfad der Quelldatei zerlegen
	Set oInFile = fso.GetFile(sInFile) 'für vollständige Dateiangaben aus Dateisystem
	sInPath = oInFile.Path 'voller Quelldateipfad - wird zum Einlesen verwendet
	sInFileName = Left(oInFile.Name, InstrRev(oInFile.Name, ".") - 1) 'Dateiname ohne Pfad und Typ
	sInFileType = Mid(oInFile.Name, InstrRev(oInFile.Name, ".")) 'für Überprüfung auf CSV
	Set oInFile = Nothing
End If

If WScript.Arguments.Count > 1 Then
	sOutFilePath = WScript.Arguments(1) 'angegebenen Zielpfad verwenden
Else
	sOutFilePath = sOutPathDefault 'kein Zielpfad angegeben - Default verwenden
End If

If Not fso.FolderExists(sOutFilePath) Then 'Zielpfad nicht vorhanden, daher ...
	On Error Resume Next
	fso.CreateFolder(sOutFilePath) '... zu erstellen versuchen
	If Err.Number > 0 Then
		WScript.Echo "Ungueltiger Zielpfad: " & sOutFilePath
		WScript.Quit(1)
	Else
		On Error Goto 0 'Standardfehlerbehandlung wieder einschalten
	End If
End If

If LCase(sInFileType) = ".csv" Then 'bei Typ ".csv" für Import in Temp-File kopieren
	sInPathTemp = sOutFilePath & "\" & sInFileName & ".tmp" 'Temp-File im Zielverzeichnis anlegen (Annahme: dort Schreibrechte)
	fso.CopyFile sInPath, sInPathTemp
	sInPath = sInPathTemp 'Daten aus Temp-File lesen
End If

sOutPath = sOutFilePath & "\" & sInFileName & ".xls" 'Zieldateipfad erstellen
Do While InStr(sOutPath, "\\") 'vermeiden doppelter (mehfacher) "\" im Zieldateipfad (stört Excel offensichtlich nur beim Speichern)
	sOutPath = Replace(sOutPath, "\\", "\")
Loop

Set oXL = CreateObject("Excel.Application")
With oXL
	.Workbooks.OpenText sInPath, , , 1, , , , True, , , , ,Array(Array(1, 1),Array(2, 2))	
	On Error Resume Next
	.ActiveWorkbook.ActiveSheet.Cells.EntireColumn.AutoFit 'Optimale Spaltenbreite für alle Spalten setzen
	.DisplayAlerts = False 'Keine Rückfrage beim Überschreiben schon vorhandener Zieldatei
	.ActiveWorkbook.SaveAs sOutPath, -4143 'Speichern als .xls
If Err.Number > 0 Then
		CleanUp
		WScript.Echo sOutPath & " konnte nicht gespeichert werden!"
		WScript.Quit(1)
	End If
	
End With
CleanUp

Sub CleanUp
oXL.Quit
Set oXL = Nothing
If LCase(sInFileType) = ".csv" Then
	On Error Resume Next
	fso.DeleteFile sInPathTemp 'temporäre Import-Datei zu löschen versuchen
End If
End Sub

evtl fällt euch ne Idee ein wie das klappen soll

thx schönes we

Ben