Forum Clubic

[RESOLU] Conversion XLS vers TXT ou CSV - Comment faire

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

Rien à voir avec prog.

Sauf si tu veux le coder toi même? Et encore…

En effet je l’ai codé :

Avec du vbs c’est possible !
Voici mon 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.

' Test program for ListDir function.
' Lists file names using wildcards.
' Author: Christian d'Heureuse (www.source-code.biz)
' License: GNU/LGPL (http://www.gnu.org/licenses/lgpl.html?#41;


'Modified by Wilfrid Burel on the 22nd November 2005 in order to be recursive
' By default the function Listdir is Recursive. If you don't want the recursivity put something as second argument
' ex : cscript ListDir "D:\temp\*.exe" 0 will scan folder temp for exe files
' ex : cscript ListDir "D:\temp"   will scan folder temp and subfolders for all files


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 = "Path des XLS ex : C:\rapports\"
	fPath = "Path de sortie en txt ex : c:\Temp\"
	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 C:\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
    Next
 CompareFileName2 = False
End Function