[RESOLU] convertir XLS en TXT ou CSV

Marsh Posté le 18-07-2006 à 18:52:43

Bonjour

Je suis a la recherche d'un moyen (ou d'un programme) "free" de convertir un fichier XLS vers un fichier TXT ou CSV, le tout en ligne de commande (batch).

Vous connaissez quelque chose ?

Tout ce que j'ai trouvé c'est payant !

Merci a vous

Message édité par orlith le 02-08-2006 à 16:46:39

Reply

Marsh Posté le 18-07-2006 à 18:52:43

Reply

Marsh Posté le 18-07-2006 à 18:54:40

Il y a une solution Linux...mais bon faut être sous Linux [:ddr555]
http://wizard.ae.krakow.pl/~jb/xls2txt/

Reply

Marsh Posté le 18-07-2006 à 18:57:33

Arghhhh !!

Moi c'est sous windows Xp !
Pas de chance.

Merci

Reply

Marsh Posté le 02-08-2006 à 16:52:16

Ca y est j'ai trouvé !

Avec du vbs c'est possible !
Voic imon script, y'a surement des améliorations a faire mais bon ca fonctionne bien comme ca !

Il lit le contenu d'un répertoire et de ses sous dossiers, transforme tout les fichier xls en txt puis supprime les répertoires.

Code :

Option Explicit
Dim a ' WB
Dim n: n = 0 ' WB
Dim Recursivity ' WB
On error resume Next
Main
Sub Main
Dim Path,count
Dim Chaine, longueur, fName
Dim i ,fs
Dim FileName, Filepath
Dim xlApp, xlWB, vPath, FSO, f, fl, fpath,oShell
Set xlApp = CreateObject("excel.application" )
vPath = "Chemins initial des xls\"
fPath = "Chemin de dépose des txt"
Set FSO = CreateObject("scripting.filesystemobject" )
xlApp.DisplayAlerts = False
'Select Case WScript.Arguments.Count
' Case 0: Path = "*.*" ' list current directory
' Case 1: Path = WScript.Arguments(0) ' WB
' Case 2: Path = WScript.Arguments(0) : Recursivity = WScript.Arguments(1) ' WB
' Case Else: WScript.Echo "Invalid number of arguments.": Exit Sub
'End Select
Select Case Recursivity ' WB
Case "" : Recursivity=True ' WB
Case Else : Recursivity=False ' WB
End Select ' WB
Path ="*.xls"
ReDim a(1,10) ' WB
'wscript.echo "ubound 1 : "&ubound(a,2)
a = ListDir(vPath & Path)
'wscript.echo "ubound 2 : "&ubound(a,2)
If UBound(a) = -1 then
WScript.Echo "No files found."
Exit Sub
End If
n=1
Do While n+1 <= UBound(a,2)
'wscript.echo ubound(a)
'wscript.echo n
Filepath=a(0,n-1)
Filename=a(1,n-1)
'wscript.echo filepath
'wscript.echo filename
Longueur=len(filePath)-66
If Longueur >0 then
FilePath = Right(FilePath,longueur) 'supprime la chaine d:\temp\ du path
Chaine = Split(FilePath, "\" ) 'splitte la chaine en morceaux en fonction de \ afin d'avoir les noms de répertoires
'For i = 0 To UBound(Chaine)
' wscript.echo "chaine: " & Chaine(i)
'Next
'Put here what you want to be done
xlApp.DisplayAlerts = False
Set xlWB = xlApp.Workbooks.Open(vPath&filepath)
fName = Chaine(1) & "_Daily_" & Left(Filename, len(filename)-4)
xlWB.SaveAs fPath & fname &".csv", 6 '6=xlcsv
xlWB.Close False
fs=FSO.deletefolder(vPath&Chaine(0)&"\"&chaine(1), True)
End If
n=n+1
Loop
xlApp.DisplayAlerts = True
Set xlWB = Nothing
xlApp.Quit
Set xlApp = Nothing
Set vPath = Nothing
End Sub
' Returns an array with the file names that match Path.
' The Path string may contain the wildcard characters "*"
' and "?" in the file name component. The same rules apply as with the MSDOS DIR command.
' If Path is a directory, the contents of this directory is listed.
' If Path is empty, the current directory is listed.
' Author: Christian d'Heureuse (www.source-code.biz)
' Modified by Wilfrid Burel on the 22nd November 2005 in order to be recursive : modification commented and signed
Public Function ListDir (ByVal Path)
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject" )
If Path = "" then Path = "*.*"
Dim Parent, Filter
if fso.FolderExists(Path) then ' Path is a directory
Parent = Path
Filter = "*"
Else
Parent = fso.GetParentFolderName(Path)
If Parent = "" Then If Right(Path,1) = ":" Then Parent = Path: Else Parent = "."
Filter = fso.GetFileName(Path)
If Filter = "" Then Filter = "*"
End If
'ReDim a(10) quote by WB
Dim Folder: Set Folder = fso.GetFolder(Parent)
Dim Files: Set Files = Folder.Files
Dim File
'Implementation of recursivity WB
If Recursivity then
Dim SubFolder ' WB
If Folder.SubFolders.Count <> 0 Then 'WB
For Each SubFolder In Folder.SubFolders ' WB
ListDir(SubFolder&"\" & Filter) ' WB
Next ' WB
End If ' WB
End If
Set Files = Folder.Files
For Each File In Files
If CompareFileName(File.Name,Filter) Then
'wscript.echo "ubound : "&ubound(a,2) & " - "&n
If n > UBound(a,2) Then ReDim Preserve a(1,n*2)
a(0,n) = File.Path
a(1,n) = File.Name
n = n + 1
End If
Next
ReDim Preserve a(1,n+2)
ListDir = a
End Function
Private Function CompareFileName (ByVal Name, ByVal Filter) ' (recursive)
CompareFileName = False
Dim np, fp: np = 1: fp = 1
Do
If fp > Len(Filter) Then CompareFileName = np > len(name): Exit Function
If Mid(Filter,fp) = ".*" Then ' special case: ".*" at end of filter
If np > Len(Name) Then CompareFileName = True: Exit Function
End If
Dim fc: fc = Mid(Filter,fp,1): fp = fp + 1
Select Case fc
Case "*"
CompareFileName = CompareFileName2(name,np,filter,fp)
Exit Function
Case "?"
If np <= Len(Name) And Mid(Name,np,1) <> "." Then np = np + 1
Case Else
If np > Len(Name) Then Exit Function
Dim nc: nc = Mid(Name,np,1): np = np + 1
If Strcomp(fc,nc,vbTextCompare)<>0 Then Exit Function
End Select
Loop
End Function
Private Function CompareFileName2 (ByVal Name, ByVal np0, ByVal Filter, ByVal fp0)
Dim fp: fp = fp0
Dim fc2
Do
If fp > Len(Filter) Then CompareFileName2 = True: Exit Function
If Mid(Filter,fp) = ".*" Then ' special case: ".*" at end of filter
CompareFileName2 = True: Exit Function
End If
fc2 = Mid(Filter,fp,1): fp = fp + 1
If fc2 <> "*" And fc2 <> "?" Then Exit Do
Loop
Dim np
For np = np0 To Len(Name)
Dim nc: nc = Mid(Name,np,1)
If StrComp(fc2,nc,vbTextCompare)=0 Then
If CompareFileName(Mid(Name,np+1),Mid(Filter,fp)) Then
CompareFileName2 = True: Exit Function
End If
End If

Reply

[RESOLU] convertir XLS en TXT ou CSV

Sujets relatifs:

Leave a Replay