|
Hallo VBA Forum,
ich bin noch Anfänger in VBA und habe mir auf die schnelle aus dem Internet einen CSV to XLS Konverter gebastelt. Dieser funktioniert soweit ganz gut. Nach dem einlesen der Daten aus der CSV Datei möchte ich die
Daten gerne weiter verarbeiten. Ich bin somit auf ein Problem gestoßen, wobei die beim Konvertieren der CSV Datei ein Fehler auftritt. Ich möchte gerne in zwei Spalten den Punkt mit einem Komma ersetzen.
In Excel mit dem Makro funktioniert dies ganz gut. Nach dem kopieren dieses Code-Teil aus dem Makro in die
.vbs Datei geht es nicht mehr.
Hinweis: Ich rufe die CSV2XLS.vbs durch eine Batch Datei auf. Ziel ist es, für die eingelesenen Messdaten
in der CSV Datei einen automatisierten Excelimport zu realisieren mit dem dazugehörigen Diagramm.
Diese Zeile macht Probleme:
.ActiveSheet.Columns("B").Replace What:=".", Replacement:=",", SearchOrder:=xlByColumns, MatchCase:=True
****************************************************************************************************
'CSV2XLS.vbs
sOutPathDefault = "C:\Users\os\Desktop\00872" '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 Comma = True
On Error Resume Next
.ActiveWorkbook.ActiveSheet.Cells.EntireColumn.AutoFit 'Optimale Spaltenbreite für alle Spalten setzen
.ActiveSheet.Columns("D:AU").Delete 'nicht benötige Spalten löschen
.ActiveSheet.Columns("B:C").NumberFormat = "@" 'Spalte mit den Druckwerten zuerst in Text wandeln
.ActiveSheet.Columns("B").Replace What:=".", Replacement:=",", SearchOrder:=xlByColumns, MatchCase:=True
.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
****************************************************************************************************
|