1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
| Option Explicit
Const ForReading = 1
Const ForWriting = 2
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
'///// Variable Declare
Dim book, CsvInput ,ExcelOutput ,csvbook, objfile
Dim fs, sArg
Dim objFSO2 : Set objFSO2 = CreateObject("Scripting.FileSystemObject")
Dim ficLog : Set ficLog = objFSO2.OpenTextFile("csv_to_excel.txt", 8, true)
ficLog.WriteLine Now & " Etape 0 : "
'On récupère les arguments
Set sArg = WScript.Arguments
'Il y a 2 arguments, fichier en entrée, fichier de sortie
If sArg.Count <> 2 Then
WScript.Quit
End If
'On récupère les 2 arguments.
CsvInput = sArg(0)
ExcelOutput = sArg(1)
'CsvInput = "\\pdecisds01wv\BODS\FLUXEGEE\out\gegse\C01\Suivi\test_csv.csv"
'ExcelOutput = "\\pdecisds01wv\BODS\FLUXEGEE\out\gegse\C01\Suivi\C01_tableau_histo.xlsx"
CsvInput = "c:\test\test_csv.csv"
ExcelOutput = "c:\test\C01_tableau_histo.xlsx"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set fs = WScript.CreateObject("Scripting.FileSystemObject")
WScript.Sleep 10000
'///// Open objects
Dim objFSO : Set objFSO = CreateObject ("Scripting.FileSystemObject")
' - File system object
Dim XL : Set XL = CreateObject ("Excel.Application")
' - Excel object
'///// Properties Excel object
XL.Visible = False
XL.DisplayAlerts = False
XL.SheetsInNewWorkbook = 1
set book = XL.Workbooks.Add
WScript.Sleep 10000
ficLog.WriteLine Now & " Etape 1 : suppression de xlsx"
'///// Supprime l'ancienne feuile excel
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(ExcelOutput) Then
FSO.DeleteFile(ExcelOutput)
End If
'///// Ouvre le csv sous Excel
Set objFSO = CreateObject("Scripting.FileSystemObject")
ficLog.WriteLine Now & " Etape 2" & CsvInput
On Error Resume Next
Set objfile = objFSO.GetFile(CsvInput)
If Err.Number <> 0 Then
ficLog.WriteLine Now & " Erreur : " & CStr(Err.Number) & " " & Err.Description
WScript.Quit Err.Number
end if
On Error GoTo 0
ficLog.WriteLine Now & " Etape 3 " & objFSO.GetAbsolutePathName(objFile)
On Error Resume Next
Set csvBook = XL.Workbooks.Open(objFSO.GetAbsolutePathName(objFile))
If Err.Number <> 0 Then
ficLog.WriteLine Now & " Erreur : " & CStr(Err.Number) & " " & Err.Description
WScript.Quit Err.Number
end if
On Error GoTo 0
ficLog.WriteLine Now & " Etape 4"
On Error Resume Next
csvBook.Sheets (1).Copy ,book.Sheets (1)
If Err.Number <> 0 Then
ficLog.WriteLine Now & " Erreur : " & CStr(Err.Number) & " " & Err.Description
WScript.Quit Err.Number
end if
On Error GoTo 0
ficLog.WriteLine Now & " Etape 5"
csvBook.Close
ficLog.WriteLine Now & " Etape 6"
'///// Enregistre le csv sous format excel
book.Sheets (1).Delete
ficLog.WriteLine Now & " Etape 7"
book.SaveAs ExcelOutput
book.Close
XL.SheetsInNewWorkbook = 3
XL.Quit
'// réouvre le workbook pour revalider la colonne des PDS
Dim Xlapp 'Excel
Dim wb, feuille 'le classeur
Set XlApp = CreateObject("Excel.application")
XlApp.Visible = false
Set Wb = XlApp.Workbooks.Open(ExcelOutput)
Wb.Sheets(1).Range("G2:G65536").Value = Wb.Sheets(1).Range("G2:G65536").FormulaR1C1
wb.close true 'ferme avec sauvegarde
XlApp.quit 'quitte excel
Set Wb = Nothing
Set XlApp = Nothing
'//////// Functions ////////
Function DeleteFile(sFile, bForce)
Dim oFso, iRet
On Error Resume Next
Set oFso = CreateObject("Scripting.FileSystemObject")
oFso.DeleteFile sFile, bForce
iRet = err=0
Err.Clear
On Error Goto 0
Set oFso = Nothing
DeleteFile = iRet
End Function |
Partager