Semi OT: Need help with VB script

Technical support and scripting issues

Moderators: Dorian (MJT support), JRL

Post Reply
matthiasR
Pro Scripter
Posts: 52
Joined: Tue Jan 20, 2004 3:45 pm
Location: Lübbecke, Germany

Semi OT: Need help with VB script

Post by matthiasR » Thu Jan 10, 2008 9:10 pm

Hi

i want to convert a CSV file to Ecel. I found a vbs script, what does this near as i want it.
But i have a column, where numbers with leading zeros are stored. After conversion the leading zero is lost. How can i treat each column as text? Furthermore i want to know, how i could specify another field delimiter in my vbs script e.g. #
Problem is, that i am completely new to vbs. Could some one help?

Matthias

Here´s the vbs

Code: Select all

'CSV2XLS.vbs
sOutPathDefault = "c:\preisgen" 'Angabe des Default-Zielpfades ohne abschließenden "\"

Set fso = CreateObject("Scripting.FileSystemObject")
If WScript.Arguments.Count = 0 Then
	WScript.Echo "Keine Quelldatei angegeben!"
	WScript.Quit(1)
End If

sInFile = WScript.Arguments(0)
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, , , , , , , True 'Delimiter Semicolon = True
	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
[/code]

Post Reply
cron
Sign up to our newsletter for free automation tips, tricks & discounts