OT: Any VBS, VBA, Excel specialist out there who might help?

runrev260805 at m-r-d.de runrev260805 at m-r-d.de
Thu Jul 23 07:15:35 EDT 2009


Hi,

i am having a problem converting a CSV file to excel.

My csv file is structured like this:

ArtNr;ShortDescription;LongDescription;ManufactureNo;EAN;Manufacturer;Stock
010002;Epson LQ300; Epson LQ 300 Matrixdrucker;C11C63800;8715946316949;Epson;2

There is no text delimiter. The field delimiter is ; . The list  
contains about 4000 lines with 13 columns. The ArtNo can contain  
leading zeros.

In the past (exactly until the 14th july) i converted this csv file  
unattended with a vbs file in revolution via "get shell". This worked  
without any problems. But now the excel file is garbled. Each  
character of the ArtNo for example is put in one seperate column.

Importing the file into Excel 2007 manually - with the "import wizard"  
where i have to define the field delimiter and the type of the columns  
(standard, text and so on) - works without problens.

So the CSV file seems to be ok. But for whatever reason my vbs script  
seems not to work any more.

My vbs file looks like this

----
'CSV2XLS.vbs

' Const
Const xlTextQualifierDoubleQuote = 1
Const xlTextQualifierSingleQuote = 2
Const xlTextQualifierNone = - 4142

Const xlGeneralFormat = 1
Const xlTextFormat = 2
Const xlMDYFormat = 3
Const xlDMYFormat = 4
Const xlYMDFormat = 5
Const xlMYDFormat = 6
Const xlDYMFormat = 7
Const xlYDMFormat = 8
Const xlSkipColumn = 9

' EndConst


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, , , ,xlTextQualifierNone,,,True,,,,  
,Array(Array(1, 2), Array(2,2), Array(3,2), Array(4,2), Array(5,2),  
Array(6,1), Array(7,1), Array(8,1), Array(9,1), Array(10,1),  
Array(11,1), Array(12,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
--

Is there something wrong with my script. I am not very familiar with vbs.
The conversion has to be done unattended every 60 minutes from 07:00am  
to 08:00pm.

At the moment i am lost :-(


Regards,

Matthias




More information about the use-livecode mailing list