Probleme de SQL

Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Entraide Applications Microsoft Office Excel Probleme de SQL

3 réponses

Ralf Meuser

10/08/2007 à 18:03

Salut a tous

J'essai de importer un fichier CSV et de crée une feuille avec un
regroupement de données.

Importations fonctionne maintenant, mais j'ai un problème pour ma requête
SQL.

Merci avance pour tout aide.

Bon week-end

Ralf

----------------------------------------------------
voici mon script
---------------------------------------------------
Option Explicit
Const vbNormal = 1 ' window style

DIM objXL, objWb, objWb2, objWb3, objR, objTab ' Excel object variables
DIM Title, Text, tmp, i, j, file, name, FileName
DIM myString

' here you may set the name of the file to be imported
file = "S:\Uniface\KPI01.TXT" ' must be located in the script folder

' create an Excel object reference
Set objXL = WScript.CreateObject ("Excel.Application")

' set the Excel window properties (not absolutely necessary)
objXL.WindowState = vbNormal ' Normal
objXL.Height = 300 ' height
objXL.Width = 400 ' width
objXL.Left = 40 ' X-Position
objXL.Top = 20 ' Y-Position
objXL.Visible = true ' show window

' Create new Workbook (needed for import the CSV file=
Set objWb = objXl.WorkBooks.Add

' Get the first loaded worksheet object of the current workbook
Set objWb = objXL.ActiveWorkBook.WorkSheets(1)
Set objWb2 = objXL.ActiveWorkBook.WorkSheets(2)
Set objWb3 = objXL.ActiveWorkBook.WorkSheets(3)
objWb.Activate ' not absolutely necessary (for CSV)
' Now invoke the import wizard

'Set objTab = objWb.QueryTables.Add ("TEXT;"+GetPath + file,
objWb.Range("A1"))
Set objTab = objWb.QueryTables.Add ("TEXT;"+file, objWb.Range("A1"))

' here comes the mumbo jumbo to set all the properties for the wizard
' Oh Microsoft, how do I wish to has a With feature or a possibility to
' pass named arguments to methods ....
objTab.Name = "Names"
objTab.FieldNames = True
objTab.RowNumbers = False
objTab.FillAdjacentFormulas = False
objTab.PreserveFormatting = True
objTab.RefreshOnFileOpen = False
objTab.RefreshStyle = 1 'xlInsertDeleteCells
objTab.SavePassword = False
objTab.SaveData = True
objTab.AdjustColumnWidth = True
objTab.RefreshPeriod = 0
objTab.TextFilePromptOnRefresh = False
objTab.TextFilePlatform = 2 'xlWindows
objTab.TextFileStartRow = 1
objTab.TextFileParseType = 1 'xlDelimited
objTab.TextFileTextQualifier = -4142 ' xlTextQualifierNone
objTab.TextFileConsecutiveDelimiter = False
objTab.TextFileTabDelimiter = False ' ### my delimiters
objTab.TextFileSemicolonDelimiter = True
objTab.TextFileCommaDelimiter = False
objTab.TextFileSpaceDelimiter = False
objTab.TextFileColumnDataTypes =
Array(1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
objTab.Refresh False

'WScript.Echo "We have loaded the worksheet"

' demonstrate how to read the column header values
Text = "Worksheet " + objWb.name + vbCRLF
Text = Text + "Column titles" + vbCRLF
Text = Text + CStr(objWb.Cells(1, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(1, 2).Value) + vbCRLF

' show some cell values (using the "hard coded method")
Text = Text + CStr(objWb.Cells(2, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(2, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(3, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(3, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(4, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(4, 2).Value) + vbCRLF

'' Show results
'MsgBox Text, vbOkOnly+ vbInformation, Title
'objXL.ActiveSheet.PrintOut ' print Worksheet
'WScript.Echo "We are printing, close after printing"

' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
'WScript.Echo "We are saving now"

'*****Feuil3 ******"
Dim cnn,rs,sql
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data
Source=C:\uti\KPI\KPI01.xls; Extended Properties=""Excel 8.0;HDR=Yes;"";"
rs.Open "SELECT LIG_MAITRE," & _
"sum(case when SEMAINE = 1 then PT else 0 end) as m1," & _
"sum(case when SEMAINE = 2 then PT else 0 end) as m2," & _
"sum(case when SEMAINE = 3 then PT else 0 end) as m3," & _
"sum(case when SEMAINE = 4 then PT else 0 end) as m4," & _
"sum(case when SEMAINE = 5 then PT else 0 end) as m5," & _
"sum(case when SEMAINE = 6 then PT else 0 end) as m6," & _
"sum(case when SEMAINE = 7 then PT else 0 end) as m7," & _
"sum(case when SEMAINE = 8 then PT else 0 end) as m8," & _
"sum(case when SEMAINE = 9 then PT else 0 end) as m9," & _
"sum(case when SEMAINE = 10 then PT else 0 end) as m10," & _
"sum(case when SEMAINE = 11 then PT else 0 end) as m11," & _
"sum(case when SEMAINE = 12 then PT else 0 end) as m12," & _
"sum(case when SEMAINE = 13 then PT else 0 end) as m13," & _
"sum(case when SEMAINE = 14 then PT else 0 end) as m14," & _
"sum(case when SEMAINE = 15 then PT else 0 end) as m15," & _
"sum(case when SEMAINE = 16 then PT else 0 end) as m16," & _
"sum(case when SEMAINE = 17 then PT else 0 end) as m17," & _
"sum(case when SEMAINE = 18 then PT else 0 end) as m18," & _
"sum(case when SEMAINE = 19 then PT else 0 end) as m19," & _
"sum(case when SEMAINE = 20 then PT else 0 end) as m20," & _
"sum(case when SEMAINE = 21 then PT else 0 end) as m21," & _
"sum(case when SEMAINE = 22 then PT else 0 end) as m22," & _
"sum(case when SEMAINE = 23 then PT else 0 end) as m23," & _
"sum(case when SEMAINE = 24 then PT else 0 end) as m24," & _
"sum(case when SEMAINE = 25 then PT else 0 end) as m25," & _
"sum(case when SEMAINE = 26 then PT else 0 end) as m26," & _
"sum(case when SEMAINE = 27 then PT else 0 end) as m27," & _
"sum(case when SEMAINE = 28 then PT else 0 end) as m28," & _
"sum(case when SEMAINE = 29 then PT else 0 end) as m29," & _
"sum(case when SEMAINE = 30 then PT else 0 end) as m30," & _
"sum(case when SEMAINE = 31 then PT else 0 end) as m31," & _
"sum(case when SEMAINE = 32 then PT else 0 end) as m32," & _
"sum(case when SEMAINE = 33 then PT else 0 end) as m33," & _
"sum(case when SEMAINE = 34 then PT else 0 end) as m34" & _
"sum(case when SEMAINE = 35 then PT else 0 end) as m35," & _
"sum(case when SEMAINE = 36 then PT else 0 end) as m36," & _
"sum(case when SEMAINE = 37 then PT else 0 end) as m37," & _
"sum(case when SEMAINE = 38 then PT else 0 end) as m38," & _
"sum(case when SEMAINE = 39 then PT else 0 end) as m39," & _
"sum(case when SEMAINE = 40 then PT else 0 end) as m40," & _
"sum(case when SEMAINE = 41 then PT else 0 end) as m41," & _
"sum(case when SEMAINE = 42 then PT else 0 end) as m42," & _
"sum(case when SEMAINE = 43 then PT else 0 end) as m43," & _
"sum(case when SEMAINE = 44 then PT else 0 end) as m44," & _
"sum(case when SEMAINE = 45 then PT else 0 end) as m45," & _
"sum(case when SEMAINE = 46 then PT else 0 end) as m46," & _
"sum(case when SEMAINE = 47 then PT else 0 end) as m47," & _
"sum(case when SEMAINE = 48 then PT else 0 end) as m48," & _
"sum(case when SEMAINE = 49 then PT else 0 end) as m49," & _
"sum(case when SEMAINE = 50 then PT else 0 end) as m50," & _
"sum(case when SEMAINE = 51 then PT else 0 end) as m51," & _
"sum(case when SEMAINE = 52 then PT else 0 end) as m52," & _
"sum(case when SEMAINE = 53 then PT else 0 end) as m53" & _
"From [Feuil1$] Group BY LIG_MAITRE",cnn,3,3,&H0001
i = 2
Do While Not rs.EOF
objWb3.Cells(i, 1) = rs("LIGNE_MAIT")
objWb3.Cells(i, 2) = rs("M1")
objWb3.Cells(i, 3) = rs("M2")
objWb3.Cells(i, 4) = rs("M3")
objWb3.Cells(i, 5) = rs("M4")
objWb3.Cells(i, 6) = rs("M5")
objWb3.Cells(i, 7) = rs("M6")
objWb3.Cells(i, 8) = rs("M7")
objWb3.Cells(i, 9) = rs("M8")
objWb3.Cells(i, 10) = rs("M9")
objWb3.Cells(i, 11) = rs("M10")
objWb3.Cells(i, 12) = rs("M11")
objWb3.Cells(i, 13) = rs("M12")
objWb3.Cells(i, 14) = rs("M13")
objWb3.Cells(i, 15) = rs("M14")
objWb3.Cells(i, 16) = rs("M15")
objWb3.Cells(i, 17) = rs("M16")
objWb3.Cells(i, 18) = rs("M17")
objWb3.Cells(i, 19) = rs("M18")
objWb3.Cells(i, 20) = rs("M19")
objWb3.Cells(i, 21) = rs("M20")
objWb3.Cells(i, 22) = rs("M21")
objWb3.Cells(i, 23) = rs("M22")
objWb3.Cells(i, 24) = rs("M23")
objWb3.Cells(i, 25) = rs("M24")
objWb3.Cells(i, 26) = rs("M25")
objWb3.Cells(i, 27) = rs("M26")
objWb3.Cells(i, 28) = rs("M27")
objWb3.Cells(i, 29) = rs("M28")
objWb3.Cells(i, 30) = rs("M29")
objWb3.Cells(i, 31) = rs("M30")
objWb3.Cells(i, 32) = rs("M31")
objWb3.Cells(i, 33) = rs("M32")
objWb3.Cells(i, 34) = rs("M33")
objWb3.Cells(i, 35) = rs("M34")
objWb3.Cells(i, 36) = rs("M35")
objWb3.Cells(i, 37) = rs("M36")
objWb3.Cells(i, 38) = rs("M37")
objWb3.Cells(i, 39) = rs("M38")
objWb3.Cells(i, 40) = rs("M39")
objWb3.Cells(i, 41) = rs("M40")
objWb3.Cells(i, 42) = rs("M41")
objWb3.Cells(i, 43) = rs("M42")
objWb3.Cells(i, 44) = rs("M43")
objWb3.Cells(i, 45) = rs("M44")
objWb3.Cells(i, 46) = rs("M45")
objWb3.Cells(i, 47) = rs("M46")
objWb3.Cells(i, 48) = rs("M47")
objWb3.Cells(i, 49) = rs("M48")
objWb3.Cells(i, 50) = rs("M49")
objWb3.Cells(i, 51) = rs("M50")
objWb3.Cells(i, 52) = rs("M51")
objWb3.Cells(i, 53) = rs("M52")
objWb3.Cells(i, 54) = rs("M53")
rs.MoveNext
i = i + 1
Loop
' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
' *********** FIN *******************'
rs.Close
cnn.Close
Set rs = Nothing
' WScript.Echo "We save now"
' save as now again
'FileName = GetPath + "KPI01.xls"
'objXL.ActiveWorkbook.SaveAs FileName
'WScript.Echo "We are saving now"

objXl.Quit() ' Quit Excel
Set objXL = Nothing
WScript.Quit()

'##########################
Function GetPath
' Retrieve the script path
DIM path
path = WScript.ScriptFullName ' Script name
GetPath = Left(path, InstrRev(path, "\"))
End Function

3 réponses

Misange

10/08/2007 à 19:09

salutatoi
euh... C'est à nous de savoir qeul problème tu rencontres ???
Quand on demande de l'aide, c'est bien de mettre le *minimum* de lignes
qui génèrent l'erreur, et surtout de préciser ce que tu fais, où ça
bloque et quel message d'erreur tu récupères. Il y a des vrais devins
(par fois en 2 mots : de vins) mais quand même ils ont leurs limites ;-)

Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

Salut a tous

J'essai de importer un fichier CSV et de crée une feuille avec un
regroupement de données.

Importations fonctionne maintenant, mais j'ai un problème pour ma requête
SQL.

Merci avance pour tout aide.

Bon week-end

Ralf

----------------------------------------------------
voici mon script
---------------------------------------------------
Option Explicit
Const vbNormal = 1 ' window style

DIM objXL, objWb, objWb2, objWb3, objR, objTab ' Excel object variables
DIM Title, Text, tmp, i, j, file, name, FileName
DIM myString

' here you may set the name of the file to be imported
file = "S:UnifaceKPI01.TXT" ' must be located in the script folder

' create an Excel object reference
Set objXL = WScript.CreateObject ("Excel.Application")

' set the Excel window properties (not absolutely necessary)
objXL.WindowState = vbNormal ' Normal
objXL.Height = 300 ' height
objXL.Width = 400 ' width
objXL.Left = 40 ' X-Position
objXL.Top = 20 ' Y-Position
objXL.Visible = true ' show window

' Create new Workbook (needed for import the CSV file > Set objWb = objXl.WorkBooks.Add

' Get the first loaded worksheet object of the current workbook
Set objWb = objXL.ActiveWorkBook.WorkSheets(1)
Set objWb2 = objXL.ActiveWorkBook.WorkSheets(2)
Set objWb3 = objXL.ActiveWorkBook.WorkSheets(3)
objWb.Activate ' not absolutely necessary (for CSV)
' Now invoke the import wizard

'Set objTab = objWb.QueryTables.Add ("TEXT;"+GetPath + file,
objWb.Range("A1"))
Set objTab = objWb.QueryTables.Add ("TEXT;"+file, objWb.Range("A1"))

' here comes the mumbo jumbo to set all the properties for the wizard
' Oh Microsoft, how do I wish to has a With feature or a possibility to
' pass named arguments to methods ....
objTab.Name = "Names"
objTab.FieldNames = True
objTab.RowNumbers = False
objTab.FillAdjacentFormulas = False
objTab.PreserveFormatting = True
objTab.RefreshOnFileOpen = False
objTab.RefreshStyle = 1 'xlInsertDeleteCells
objTab.SavePassword = False
objTab.SaveData = True
objTab.AdjustColumnWidth = True
objTab.RefreshPeriod = 0
objTab.TextFilePromptOnRefresh = False
objTab.TextFilePlatform = 2 'xlWindows
objTab.TextFileStartRow = 1
objTab.TextFileParseType = 1 'xlDelimited
objTab.TextFileTextQualifier = -4142 ' xlTextQualifierNone
objTab.TextFileConsecutiveDelimiter = False
objTab.TextFileTabDelimiter = False ' ### my delimiters
objTab.TextFileSemicolonDelimiter = True
objTab.TextFileCommaDelimiter = False
objTab.TextFileSpaceDelimiter = False
objTab.TextFileColumnDataTypes =
Array(1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
objTab.Refresh False

'WScript.Echo "We have loaded the worksheet"

' demonstrate how to read the column header values
Text = "Worksheet " + objWb.name + vbCRLF
Text = Text + "Column titles" + vbCRLF
Text = Text + CStr(objWb.Cells(1, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(1, 2).Value) + vbCRLF

' show some cell values (using the "hard coded method")
Text = Text + CStr(objWb.Cells(2, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(2, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(3, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(3, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(4, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(4, 2).Value) + vbCRLF

'' Show results
'MsgBox Text, vbOkOnly+ vbInformation, Title
'objXL.ActiveSheet.PrintOut ' print Worksheet
'WScript.Echo "We are printing, close after printing"

' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
'WScript.Echo "We are saving now"

'*****Feuil3 ******"
Dim cnn,rs,sql
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data
Source=C:utiKPIKPI01.xls; Extended Properties=""Excel 8.0;HDR=Yes;"";"
rs.Open "SELECT LIG_MAITRE," & _
"sum(case when SEMAINE = 1 then PT else 0 end) as m1," & _
"sum(case when SEMAINE = 2 then PT else 0 end) as m2," & _
"sum(case when SEMAINE = 3 then PT else 0 end) as m3," & _
"sum(case when SEMAINE = 4 then PT else 0 end) as m4," & _
"sum(case when SEMAINE = 5 then PT else 0 end) as m5," & _
"sum(case when SEMAINE = 6 then PT else 0 end) as m6," & _
"sum(case when SEMAINE = 7 then PT else 0 end) as m7," & _
"sum(case when SEMAINE = 8 then PT else 0 end) as m8," & _
"sum(case when SEMAINE = 9 then PT else 0 end) as m9," & _
"sum(case when SEMAINE = 10 then PT else 0 end) as m10," & _
"sum(case when SEMAINE = 11 then PT else 0 end) as m11," & _
"sum(case when SEMAINE = 12 then PT else 0 end) as m12," & _
"sum(case when SEMAINE = 13 then PT else 0 end) as m13," & _
"sum(case when SEMAINE = 14 then PT else 0 end) as m14," & _
"sum(case when SEMAINE = 15 then PT else 0 end) as m15," & _
"sum(case when SEMAINE = 16 then PT else 0 end) as m16," & _
"sum(case when SEMAINE = 17 then PT else 0 end) as m17," & _
"sum(case when SEMAINE = 18 then PT else 0 end) as m18," & _
"sum(case when SEMAINE = 19 then PT else 0 end) as m19," & _
"sum(case when SEMAINE = 20 then PT else 0 end) as m20," & _
"sum(case when SEMAINE = 21 then PT else 0 end) as m21," & _
"sum(case when SEMAINE = 22 then PT else 0 end) as m22," & _
"sum(case when SEMAINE = 23 then PT else 0 end) as m23," & _
"sum(case when SEMAINE = 24 then PT else 0 end) as m24," & _
"sum(case when SEMAINE = 25 then PT else 0 end) as m25," & _
"sum(case when SEMAINE = 26 then PT else 0 end) as m26," & _
"sum(case when SEMAINE = 27 then PT else 0 end) as m27," & _
"sum(case when SEMAINE = 28 then PT else 0 end) as m28," & _
"sum(case when SEMAINE = 29 then PT else 0 end) as m29," & _
"sum(case when SEMAINE = 30 then PT else 0 end) as m30," & _
"sum(case when SEMAINE = 31 then PT else 0 end) as m31," & _
"sum(case when SEMAINE = 32 then PT else 0 end) as m32," & _
"sum(case when SEMAINE = 33 then PT else 0 end) as m33," & _
"sum(case when SEMAINE = 34 then PT else 0 end) as m34" & _
"sum(case when SEMAINE = 35 then PT else 0 end) as m35," & _
"sum(case when SEMAINE = 36 then PT else 0 end) as m36," & _
"sum(case when SEMAINE = 37 then PT else 0 end) as m37," & _
"sum(case when SEMAINE = 38 then PT else 0 end) as m38," & _
"sum(case when SEMAINE = 39 then PT else 0 end) as m39," & _
"sum(case when SEMAINE = 40 then PT else 0 end) as m40," & _
"sum(case when SEMAINE = 41 then PT else 0 end) as m41," & _
"sum(case when SEMAINE = 42 then PT else 0 end) as m42," & _
"sum(case when SEMAINE = 43 then PT else 0 end) as m43," & _
"sum(case when SEMAINE = 44 then PT else 0 end) as m44," & _
"sum(case when SEMAINE = 45 then PT else 0 end) as m45," & _
"sum(case when SEMAINE = 46 then PT else 0 end) as m46," & _
"sum(case when SEMAINE = 47 then PT else 0 end) as m47," & _
"sum(case when SEMAINE = 48 then PT else 0 end) as m48," & _
"sum(case when SEMAINE = 49 then PT else 0 end) as m49," & _
"sum(case when SEMAINE = 50 then PT else 0 end) as m50," & _
"sum(case when SEMAINE = 51 then PT else 0 end) as m51," & _
"sum(case when SEMAINE = 52 then PT else 0 end) as m52," & _
"sum(case when SEMAINE = 53 then PT else 0 end) as m53" & _
"From [Feuil1$] Group BY LIG_MAITRE",cnn,3,3,&H0001
i = 2
Do While Not rs.EOF
objWb3.Cells(i, 1) = rs("LIGNE_MAIT")
objWb3.Cells(i, 2) = rs("M1")
objWb3.Cells(i, 3) = rs("M2")
objWb3.Cells(i, 4) = rs("M3")
objWb3.Cells(i, 5) = rs("M4")
objWb3.Cells(i, 6) = rs("M5")
objWb3.Cells(i, 7) = rs("M6")
objWb3.Cells(i, 8) = rs("M7")
objWb3.Cells(i, 9) = rs("M8")
objWb3.Cells(i, 10) = rs("M9")
objWb3.Cells(i, 11) = rs("M10")
objWb3.Cells(i, 12) = rs("M11")
objWb3.Cells(i, 13) = rs("M12")
objWb3.Cells(i, 14) = rs("M13")
objWb3.Cells(i, 15) = rs("M14")
objWb3.Cells(i, 16) = rs("M15")
objWb3.Cells(i, 17) = rs("M16")
objWb3.Cells(i, 18) = rs("M17")
objWb3.Cells(i, 19) = rs("M18")
objWb3.Cells(i, 20) = rs("M19")
objWb3.Cells(i, 21) = rs("M20")
objWb3.Cells(i, 22) = rs("M21")
objWb3.Cells(i, 23) = rs("M22")
objWb3.Cells(i, 24) = rs("M23")
objWb3.Cells(i, 25) = rs("M24")
objWb3.Cells(i, 26) = rs("M25")
objWb3.Cells(i, 27) = rs("M26")
objWb3.Cells(i, 28) = rs("M27")
objWb3.Cells(i, 29) = rs("M28")
objWb3.Cells(i, 30) = rs("M29")
objWb3.Cells(i, 31) = rs("M30")
objWb3.Cells(i, 32) = rs("M31")
objWb3.Cells(i, 33) = rs("M32")
objWb3.Cells(i, 34) = rs("M33")
objWb3.Cells(i, 35) = rs("M34")
objWb3.Cells(i, 36) = rs("M35")
objWb3.Cells(i, 37) = rs("M36")
objWb3.Cells(i, 38) = rs("M37")
objWb3.Cells(i, 39) = rs("M38")
objWb3.Cells(i, 40) = rs("M39")
objWb3.Cells(i, 41) = rs("M40")
objWb3.Cells(i, 42) = rs("M41")
objWb3.Cells(i, 43) = rs("M42")
objWb3.Cells(i, 44) = rs("M43")
objWb3.Cells(i, 45) = rs("M44")
objWb3.Cells(i, 46) = rs("M45")
objWb3.Cells(i, 47) = rs("M46")
objWb3.Cells(i, 48) = rs("M47")
objWb3.Cells(i, 49) = rs("M48")
objWb3.Cells(i, 50) = rs("M49")
objWb3.Cells(i, 51) = rs("M50")
objWb3.Cells(i, 52) = rs("M51")
objWb3.Cells(i, 53) = rs("M52")
objWb3.Cells(i, 54) = rs("M53")
rs.MoveNext
i = i + 1
Loop
' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
' *********** FIN *******************'
rs.Close
cnn.Close
Set rs = Nothing
' WScript.Echo "We save now"
' save as now again
'FileName = GetPath + "KPI01.xls"
'objXL.ActiveWorkbook.SaveAs FileName
'WScript.Echo "We are saving now"

objXl.Quit() ' Quit Excel
Set objXL = Nothing
WScript.Quit()

'##########################
Function GetPath
' Retrieve the script path
DIM path
path = WScript.ScriptFullName ' Script name
GetPath = Left(path, InstrRev(path, ""))
End Function

salutatoi
euh... C'est à nous de savoir qeul problème tu rencontres ???
Quand on demande de l'aide, c'est bien de mettre le *minimum* de lignes
qui génèrent l'erreur, et surtout de préciser ce que tu fais, où ça
bloque et quel message d'erreur tu récupères. Il y a des vrais devins
(par fois en 2 mots : de vins) mais quand même ils ont leurs limites ;-)

Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

Salut a tous

J'essai de importer un fichier CSV et de crée une feuille avec un
regroupement de données.

Importations fonctionne maintenant, mais j'ai un problème pour ma requête
SQL.

Merci avance pour tout aide.

Bon week-end

Ralf

----------------------------------------------------
voici mon script
---------------------------------------------------
Option Explicit
Const vbNormal = 1 ' window style

DIM objXL, objWb, objWb2, objWb3, objR, objTab ' Excel object variables
DIM Title, Text, tmp, i, j, file, name, FileName
DIM myString

' here you may set the name of the file to be imported
file = "S:UnifaceKPI01.TXT" ' must be located in the script folder

' create an Excel object reference
Set objXL = WScript.CreateObject ("Excel.Application")

' set the Excel window properties (not absolutely necessary)
objXL.WindowState = vbNormal ' Normal
objXL.Height = 300 ' height
objXL.Width = 400 ' width
objXL.Left = 40 ' X-Position
objXL.Top = 20 ' Y-Position
objXL.Visible = true ' show window

' Create new Workbook (needed for import the CSV file > Set objWb = objXl.WorkBooks.Add

' Get the first loaded worksheet object of the current workbook
Set objWb = objXL.ActiveWorkBook.WorkSheets(1)
Set objWb2 = objXL.ActiveWorkBook.WorkSheets(2)
Set objWb3 = objXL.ActiveWorkBook.WorkSheets(3)
objWb.Activate ' not absolutely necessary (for CSV)
' Now invoke the import wizard

'Set objTab = objWb.QueryTables.Add ("TEXT;"+GetPath + file,
objWb.Range("A1"))
Set objTab = objWb.QueryTables.Add ("TEXT;"+file, objWb.Range("A1"))

' here comes the mumbo jumbo to set all the properties for the wizard
' Oh Microsoft, how do I wish to has a With feature or a possibility to
' pass named arguments to methods ....
objTab.Name = "Names"
objTab.FieldNames = True
objTab.RowNumbers = False
objTab.FillAdjacentFormulas = False
objTab.PreserveFormatting = True
objTab.RefreshOnFileOpen = False
objTab.RefreshStyle = 1 'xlInsertDeleteCells
objTab.SavePassword = False
objTab.SaveData = True
objTab.AdjustColumnWidth = True
objTab.RefreshPeriod = 0
objTab.TextFilePromptOnRefresh = False
objTab.TextFilePlatform = 2 'xlWindows
objTab.TextFileStartRow = 1
objTab.TextFileParseType = 1 'xlDelimited
objTab.TextFileTextQualifier = -4142 ' xlTextQualifierNone
objTab.TextFileConsecutiveDelimiter = False
objTab.TextFileTabDelimiter = False ' ### my delimiters
objTab.TextFileSemicolonDelimiter = True
objTab.TextFileCommaDelimiter = False
objTab.TextFileSpaceDelimiter = False
objTab.TextFileColumnDataTypes =
Array(1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
objTab.Refresh False

'WScript.Echo "We have loaded the worksheet"

' demonstrate how to read the column header values
Text = "Worksheet " + objWb.name + vbCRLF
Text = Text + "Column titles" + vbCRLF
Text = Text + CStr(objWb.Cells(1, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(1, 2).Value) + vbCRLF

' show some cell values (using the "hard coded method")
Text = Text + CStr(objWb.Cells(2, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(2, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(3, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(3, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(4, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(4, 2).Value) + vbCRLF

'' Show results
'MsgBox Text, vbOkOnly+ vbInformation, Title
'objXL.ActiveSheet.PrintOut ' print Worksheet
'WScript.Echo "We are printing, close after printing"

' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
'WScript.Echo "We are saving now"

'*****Feuil3 ******"
Dim cnn,rs,sql
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data
Source=C:utiKPIKPI01.xls; Extended Properties=""Excel 8.0;HDR=Yes;"";"
rs.Open "SELECT LIG_MAITRE," & _
"sum(case when SEMAINE = 1 then PT else 0 end) as m1," & _
"sum(case when SEMAINE = 2 then PT else 0 end) as m2," & _
"sum(case when SEMAINE = 3 then PT else 0 end) as m3," & _
"sum(case when SEMAINE = 4 then PT else 0 end) as m4," & _
"sum(case when SEMAINE = 5 then PT else 0 end) as m5," & _
"sum(case when SEMAINE = 6 then PT else 0 end) as m6," & _
"sum(case when SEMAINE = 7 then PT else 0 end) as m7," & _
"sum(case when SEMAINE = 8 then PT else 0 end) as m8," & _
"sum(case when SEMAINE = 9 then PT else 0 end) as m9," & _
"sum(case when SEMAINE = 10 then PT else 0 end) as m10," & _
"sum(case when SEMAINE = 11 then PT else 0 end) as m11," & _
"sum(case when SEMAINE = 12 then PT else 0 end) as m12," & _
"sum(case when SEMAINE = 13 then PT else 0 end) as m13," & _
"sum(case when SEMAINE = 14 then PT else 0 end) as m14," & _
"sum(case when SEMAINE = 15 then PT else 0 end) as m15," & _
"sum(case when SEMAINE = 16 then PT else 0 end) as m16," & _
"sum(case when SEMAINE = 17 then PT else 0 end) as m17," & _
"sum(case when SEMAINE = 18 then PT else 0 end) as m18," & _
"sum(case when SEMAINE = 19 then PT else 0 end) as m19," & _
"sum(case when SEMAINE = 20 then PT else 0 end) as m20," & _
"sum(case when SEMAINE = 21 then PT else 0 end) as m21," & _
"sum(case when SEMAINE = 22 then PT else 0 end) as m22," & _
"sum(case when SEMAINE = 23 then PT else 0 end) as m23," & _
"sum(case when SEMAINE = 24 then PT else 0 end) as m24," & _
"sum(case when SEMAINE = 25 then PT else 0 end) as m25," & _
"sum(case when SEMAINE = 26 then PT else 0 end) as m26," & _
"sum(case when SEMAINE = 27 then PT else 0 end) as m27," & _
"sum(case when SEMAINE = 28 then PT else 0 end) as m28," & _
"sum(case when SEMAINE = 29 then PT else 0 end) as m29," & _
"sum(case when SEMAINE = 30 then PT else 0 end) as m30," & _
"sum(case when SEMAINE = 31 then PT else 0 end) as m31," & _
"sum(case when SEMAINE = 32 then PT else 0 end) as m32," & _
"sum(case when SEMAINE = 33 then PT else 0 end) as m33," & _
"sum(case when SEMAINE = 34 then PT else 0 end) as m34" & _
"sum(case when SEMAINE = 35 then PT else 0 end) as m35," & _
"sum(case when SEMAINE = 36 then PT else 0 end) as m36," & _
"sum(case when SEMAINE = 37 then PT else 0 end) as m37," & _
"sum(case when SEMAINE = 38 then PT else 0 end) as m38," & _
"sum(case when SEMAINE = 39 then PT else 0 end) as m39," & _
"sum(case when SEMAINE = 40 then PT else 0 end) as m40," & _
"sum(case when SEMAINE = 41 then PT else 0 end) as m41," & _
"sum(case when SEMAINE = 42 then PT else 0 end) as m42," & _
"sum(case when SEMAINE = 43 then PT else 0 end) as m43," & _
"sum(case when SEMAINE = 44 then PT else 0 end) as m44," & _
"sum(case when SEMAINE = 45 then PT else 0 end) as m45," & _
"sum(case when SEMAINE = 46 then PT else 0 end) as m46," & _
"sum(case when SEMAINE = 47 then PT else 0 end) as m47," & _
"sum(case when SEMAINE = 48 then PT else 0 end) as m48," & _
"sum(case when SEMAINE = 49 then PT else 0 end) as m49," & _
"sum(case when SEMAINE = 50 then PT else 0 end) as m50," & _
"sum(case when SEMAINE = 51 then PT else 0 end) as m51," & _
"sum(case when SEMAINE = 52 then PT else 0 end) as m52," & _
"sum(case when SEMAINE = 53 then PT else 0 end) as m53" & _
"From [Feuil1$] Group BY LIG_MAITRE",cnn,3,3,&H0001
i = 2
Do While Not rs.EOF
objWb3.Cells(i, 1) = rs("LIGNE_MAIT")
objWb3.Cells(i, 2) = rs("M1")
objWb3.Cells(i, 3) = rs("M2")
objWb3.Cells(i, 4) = rs("M3")
objWb3.Cells(i, 5) = rs("M4")
objWb3.Cells(i, 6) = rs("M5")
objWb3.Cells(i, 7) = rs("M6")
objWb3.Cells(i, 8) = rs("M7")
objWb3.Cells(i, 9) = rs("M8")
objWb3.Cells(i, 10) = rs("M9")
objWb3.Cells(i, 11) = rs("M10")
objWb3.Cells(i, 12) = rs("M11")
objWb3.Cells(i, 13) = rs("M12")
objWb3.Cells(i, 14) = rs("M13")
objWb3.Cells(i, 15) = rs("M14")
objWb3.Cells(i, 16) = rs("M15")
objWb3.Cells(i, 17) = rs("M16")
objWb3.Cells(i, 18) = rs("M17")
objWb3.Cells(i, 19) = rs("M18")
objWb3.Cells(i, 20) = rs("M19")
objWb3.Cells(i, 21) = rs("M20")
objWb3.Cells(i, 22) = rs("M21")
objWb3.Cells(i, 23) = rs("M22")
objWb3.Cells(i, 24) = rs("M23")
objWb3.Cells(i, 25) = rs("M24")
objWb3.Cells(i, 26) = rs("M25")
objWb3.Cells(i, 27) = rs("M26")
objWb3.Cells(i, 28) = rs("M27")
objWb3.Cells(i, 29) = rs("M28")
objWb3.Cells(i, 30) = rs("M29")
objWb3.Cells(i, 31) = rs("M30")
objWb3.Cells(i, 32) = rs("M31")
objWb3.Cells(i, 33) = rs("M32")
objWb3.Cells(i, 34) = rs("M33")
objWb3.Cells(i, 35) = rs("M34")
objWb3.Cells(i, 36) = rs("M35")
objWb3.Cells(i, 37) = rs("M36")
objWb3.Cells(i, 38) = rs("M37")
objWb3.Cells(i, 39) = rs("M38")
objWb3.Cells(i, 40) = rs("M39")
objWb3.Cells(i, 41) = rs("M40")
objWb3.Cells(i, 42) = rs("M41")
objWb3.Cells(i, 43) = rs("M42")
objWb3.Cells(i, 44) = rs("M43")
objWb3.Cells(i, 45) = rs("M44")
objWb3.Cells(i, 46) = rs("M45")
objWb3.Cells(i, 47) = rs("M46")
objWb3.Cells(i, 48) = rs("M47")
objWb3.Cells(i, 49) = rs("M48")
objWb3.Cells(i, 50) = rs("M49")
objWb3.Cells(i, 51) = rs("M50")
objWb3.Cells(i, 52) = rs("M51")
objWb3.Cells(i, 53) = rs("M52")
objWb3.Cells(i, 54) = rs("M53")
rs.MoveNext
i = i + 1
Loop
' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
' *********** FIN *******************'
rs.Close
cnn.Close
Set rs = Nothing
' WScript.Echo "We save now"
' save as now again
'FileName = GetPath + "KPI01.xls"
'objXL.ActiveWorkbook.SaveAs FileName
'WScript.Echo "We are saving now"

objXl.Quit() ' Quit Excel
Set objXL = Nothing
WScript.Quit()

'##########################
Function GetPath
' Retrieve the script path
DIM path
path = WScript.ScriptFullName ' Script name
GetPath = Left(path, InstrRev(path, ""))
End Function

Vous avez filtré cet utilisateur ! Consultez son message

salutatoi
euh... C'est à nous de savoir qeul problème tu rencontres ???
Quand on demande de l'aide, c'est bien de mettre le *minimum* de lignes
qui génèrent l'erreur, et surtout de préciser ce que tu fais, où ça
bloque et quel message d'erreur tu récupères. Il y a des vrais devins
(par fois en 2 mots : de vins) mais quand même ils ont leurs limites ;-)

Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

Salut a tous

J'essai de importer un fichier CSV et de crée une feuille avec un
regroupement de données.

Importations fonctionne maintenant, mais j'ai un problème pour ma requête
SQL.

Merci avance pour tout aide.

Bon week-end

Ralf

----------------------------------------------------
voici mon script
---------------------------------------------------
Option Explicit
Const vbNormal = 1 ' window style

DIM objXL, objWb, objWb2, objWb3, objR, objTab ' Excel object variables
DIM Title, Text, tmp, i, j, file, name, FileName
DIM myString

' here you may set the name of the file to be imported
file = "S:UnifaceKPI01.TXT" ' must be located in the script folder

' create an Excel object reference
Set objXL = WScript.CreateObject ("Excel.Application")

' set the Excel window properties (not absolutely necessary)
objXL.WindowState = vbNormal ' Normal
objXL.Height = 300 ' height
objXL.Width = 400 ' width
objXL.Left = 40 ' X-Position
objXL.Top = 20 ' Y-Position
objXL.Visible = true ' show window

' Create new Workbook (needed for import the CSV file > Set objWb = objXl.WorkBooks.Add

' Get the first loaded worksheet object of the current workbook
Set objWb = objXL.ActiveWorkBook.WorkSheets(1)
Set objWb2 = objXL.ActiveWorkBook.WorkSheets(2)
Set objWb3 = objXL.ActiveWorkBook.WorkSheets(3)
objWb.Activate ' not absolutely necessary (for CSV)
' Now invoke the import wizard

'Set objTab = objWb.QueryTables.Add ("TEXT;"+GetPath + file,
objWb.Range("A1"))
Set objTab = objWb.QueryTables.Add ("TEXT;"+file, objWb.Range("A1"))

' here comes the mumbo jumbo to set all the properties for the wizard
' Oh Microsoft, how do I wish to has a With feature or a possibility to
' pass named arguments to methods ....
objTab.Name = "Names"
objTab.FieldNames = True
objTab.RowNumbers = False
objTab.FillAdjacentFormulas = False
objTab.PreserveFormatting = True
objTab.RefreshOnFileOpen = False
objTab.RefreshStyle = 1 'xlInsertDeleteCells
objTab.SavePassword = False
objTab.SaveData = True
objTab.AdjustColumnWidth = True
objTab.RefreshPeriod = 0
objTab.TextFilePromptOnRefresh = False
objTab.TextFilePlatform = 2 'xlWindows
objTab.TextFileStartRow = 1
objTab.TextFileParseType = 1 'xlDelimited
objTab.TextFileTextQualifier = -4142 ' xlTextQualifierNone
objTab.TextFileConsecutiveDelimiter = False
objTab.TextFileTabDelimiter = False ' ### my delimiters
objTab.TextFileSemicolonDelimiter = True
objTab.TextFileCommaDelimiter = False
objTab.TextFileSpaceDelimiter = False
objTab.TextFileColumnDataTypes =
Array(1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
objTab.Refresh False

'WScript.Echo "We have loaded the worksheet"

' demonstrate how to read the column header values
Text = "Worksheet " + objWb.name + vbCRLF
Text = Text + "Column titles" + vbCRLF
Text = Text + CStr(objWb.Cells(1, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(1, 2).Value) + vbCRLF

' show some cell values (using the "hard coded method")
Text = Text + CStr(objWb.Cells(2, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(2, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(3, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(3, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(4, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(4, 2).Value) + vbCRLF

'' Show results
'MsgBox Text, vbOkOnly+ vbInformation, Title
'objXL.ActiveSheet.PrintOut ' print Worksheet
'WScript.Echo "We are printing, close after printing"

' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
'WScript.Echo "We are saving now"

'*****Feuil3 ******"
Dim cnn,rs,sql
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data
Source=C:utiKPIKPI01.xls; Extended Properties=""Excel 8.0;HDR=Yes;"";"
rs.Open "SELECT LIG_MAITRE," & _
"sum(case when SEMAINE = 1 then PT else 0 end) as m1," & _
"sum(case when SEMAINE = 2 then PT else 0 end) as m2," & _
"sum(case when SEMAINE = 3 then PT else 0 end) as m3," & _
"sum(case when SEMAINE = 4 then PT else 0 end) as m4," & _
"sum(case when SEMAINE = 5 then PT else 0 end) as m5," & _
"sum(case when SEMAINE = 6 then PT else 0 end) as m6," & _
"sum(case when SEMAINE = 7 then PT else 0 end) as m7," & _
"sum(case when SEMAINE = 8 then PT else 0 end) as m8," & _
"sum(case when SEMAINE = 9 then PT else 0 end) as m9," & _
"sum(case when SEMAINE = 10 then PT else 0 end) as m10," & _
"sum(case when SEMAINE = 11 then PT else 0 end) as m11," & _
"sum(case when SEMAINE = 12 then PT else 0 end) as m12," & _
"sum(case when SEMAINE = 13 then PT else 0 end) as m13," & _
"sum(case when SEMAINE = 14 then PT else 0 end) as m14," & _
"sum(case when SEMAINE = 15 then PT else 0 end) as m15," & _
"sum(case when SEMAINE = 16 then PT else 0 end) as m16," & _
"sum(case when SEMAINE = 17 then PT else 0 end) as m17," & _
"sum(case when SEMAINE = 18 then PT else 0 end) as m18," & _
"sum(case when SEMAINE = 19 then PT else 0 end) as m19," & _
"sum(case when SEMAINE = 20 then PT else 0 end) as m20," & _
"sum(case when SEMAINE = 21 then PT else 0 end) as m21," & _
"sum(case when SEMAINE = 22 then PT else 0 end) as m22," & _
"sum(case when SEMAINE = 23 then PT else 0 end) as m23," & _
"sum(case when SEMAINE = 24 then PT else 0 end) as m24," & _
"sum(case when SEMAINE = 25 then PT else 0 end) as m25," & _
"sum(case when SEMAINE = 26 then PT else 0 end) as m26," & _
"sum(case when SEMAINE = 27 then PT else 0 end) as m27," & _
"sum(case when SEMAINE = 28 then PT else 0 end) as m28," & _
"sum(case when SEMAINE = 29 then PT else 0 end) as m29," & _
"sum(case when SEMAINE = 30 then PT else 0 end) as m30," & _
"sum(case when SEMAINE = 31 then PT else 0 end) as m31," & _
"sum(case when SEMAINE = 32 then PT else 0 end) as m32," & _
"sum(case when SEMAINE = 33 then PT else 0 end) as m33," & _
"sum(case when SEMAINE = 34 then PT else 0 end) as m34" & _
"sum(case when SEMAINE = 35 then PT else 0 end) as m35," & _
"sum(case when SEMAINE = 36 then PT else 0 end) as m36," & _
"sum(case when SEMAINE = 37 then PT else 0 end) as m37," & _
"sum(case when SEMAINE = 38 then PT else 0 end) as m38," & _
"sum(case when SEMAINE = 39 then PT else 0 end) as m39," & _
"sum(case when SEMAINE = 40 then PT else 0 end) as m40," & _
"sum(case when SEMAINE = 41 then PT else 0 end) as m41," & _
"sum(case when SEMAINE = 42 then PT else 0 end) as m42," & _
"sum(case when SEMAINE = 43 then PT else 0 end) as m43," & _
"sum(case when SEMAINE = 44 then PT else 0 end) as m44," & _
"sum(case when SEMAINE = 45 then PT else 0 end) as m45," & _
"sum(case when SEMAINE = 46 then PT else 0 end) as m46," & _
"sum(case when SEMAINE = 47 then PT else 0 end) as m47," & _
"sum(case when SEMAINE = 48 then PT else 0 end) as m48," & _
"sum(case when SEMAINE = 49 then PT else 0 end) as m49," & _
"sum(case when SEMAINE = 50 then PT else 0 end) as m50," & _
"sum(case when SEMAINE = 51 then PT else 0 end) as m51," & _
"sum(case when SEMAINE = 52 then PT else 0 end) as m52," & _
"sum(case when SEMAINE = 53 then PT else 0 end) as m53" & _
"From [Feuil1$] Group BY LIG_MAITRE",cnn,3,3,&H0001
i = 2
Do While Not rs.EOF
objWb3.Cells(i, 1) = rs("LIGNE_MAIT")
objWb3.Cells(i, 2) = rs("M1")
objWb3.Cells(i, 3) = rs("M2")
objWb3.Cells(i, 4) = rs("M3")
objWb3.Cells(i, 5) = rs("M4")
objWb3.Cells(i, 6) = rs("M5")
objWb3.Cells(i, 7) = rs("M6")
objWb3.Cells(i, 8) = rs("M7")
objWb3.Cells(i, 9) = rs("M8")
objWb3.Cells(i, 10) = rs("M9")
objWb3.Cells(i, 11) = rs("M10")
objWb3.Cells(i, 12) = rs("M11")
objWb3.Cells(i, 13) = rs("M12")
objWb3.Cells(i, 14) = rs("M13")
objWb3.Cells(i, 15) = rs("M14")
objWb3.Cells(i, 16) = rs("M15")
objWb3.Cells(i, 17) = rs("M16")
objWb3.Cells(i, 18) = rs("M17")
objWb3.Cells(i, 19) = rs("M18")
objWb3.Cells(i, 20) = rs("M19")
objWb3.Cells(i, 21) = rs("M20")
objWb3.Cells(i, 22) = rs("M21")
objWb3.Cells(i, 23) = rs("M22")
objWb3.Cells(i, 24) = rs("M23")
objWb3.Cells(i, 25) = rs("M24")
objWb3.Cells(i, 26) = rs("M25")
objWb3.Cells(i, 27) = rs("M26")
objWb3.Cells(i, 28) = rs("M27")
objWb3.Cells(i, 29) = rs("M28")
objWb3.Cells(i, 30) = rs("M29")
objWb3.Cells(i, 31) = rs("M30")
objWb3.Cells(i, 32) = rs("M31")
objWb3.Cells(i, 33) = rs("M32")
objWb3.Cells(i, 34) = rs("M33")
objWb3.Cells(i, 35) = rs("M34")
objWb3.Cells(i, 36) = rs("M35")
objWb3.Cells(i, 37) = rs("M36")
objWb3.Cells(i, 38) = rs("M37")
objWb3.Cells(i, 39) = rs("M38")
objWb3.Cells(i, 40) = rs("M39")
objWb3.Cells(i, 41) = rs("M40")
objWb3.Cells(i, 42) = rs("M41")
objWb3.Cells(i, 43) = rs("M42")
objWb3.Cells(i, 44) = rs("M43")
objWb3.Cells(i, 45) = rs("M44")
objWb3.Cells(i, 46) = rs("M45")
objWb3.Cells(i, 47) = rs("M46")
objWb3.Cells(i, 48) = rs("M47")
objWb3.Cells(i, 49) = rs("M48")
objWb3.Cells(i, 50) = rs("M49")
objWb3.Cells(i, 51) = rs("M50")
objWb3.Cells(i, 52) = rs("M51")
objWb3.Cells(i, 53) = rs("M52")
objWb3.Cells(i, 54) = rs("M53")
rs.MoveNext
i = i + 1
Loop
' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
' *********** FIN *******************'
rs.Close
cnn.Close
Set rs = Nothing
' WScript.Echo "We save now"
' save as now again
'FileName = GetPath + "KPI01.xls"
'objXL.ActiveWorkbook.SaveAs FileName
'WScript.Echo "We are saving now"

objXl.Quit() ' Quit Excel
Set objXL = Nothing
WScript.Quit()

'##########################
Function GetPath
' Retrieve the script path
DIM path
path = WScript.ScriptFullName ' Script name
GetPath = Left(path, InstrRev(path, ""))
End Function

MichDenis

10/08/2007 à 19:17

Tu dois ajouter à ton classeur à partir de l'interface
de l'éditeur de code la référence suivante :

"Microsoft Activex Data Object 2.x librairy"

et essaie de déclarer tes objets de cette manière pour la section "Feuil3"

Dim cnn As ADODB.Connection, rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open ... la suite

Set rs = New ADODB.Recordset

"Ralf Meuser" a écrit dans le message de news:
46bc8c4b$0$425$
Salut a tous

J'essai de importer un fichier CSV et de crée une feuille avec un
regroupement de données.

Importations fonctionne maintenant, mais j'ai un problème pour ma requête
SQL.

Merci avance pour tout aide.

Bon week-end

Ralf

----------------------------------------------------
voici mon script
---------------------------------------------------
Option Explicit
Const vbNormal = 1 ' window style

DIM objXL, objWb, objWb2, objWb3, objR, objTab ' Excel object variables
DIM Title, Text, tmp, i, j, file, name, FileName
DIM myString

' here you may set the name of the file to be imported
file = "S:UnifaceKPI01.TXT" ' must be located in the script folder

' create an Excel object reference
Set objXL = WScript.CreateObject ("Excel.Application")

' set the Excel window properties (not absolutely necessary)
objXL.WindowState = vbNormal ' Normal
objXL.Height = 300 ' height
objXL.Width = 400 ' width
objXL.Left = 40 ' X-Position
objXL.Top = 20 ' Y-Position
objXL.Visible = true ' show window

' Create new Workbook (needed for import the CSV file Set objWb = objXl.WorkBooks.Add

' Get the first loaded worksheet object of the current workbook
Set objWb = objXL.ActiveWorkBook.WorkSheets(1)
Set objWb2 = objXL.ActiveWorkBook.WorkSheets(2)
Set objWb3 = objXL.ActiveWorkBook.WorkSheets(3)
objWb.Activate ' not absolutely necessary (for CSV)
' Now invoke the import wizard

'Set objTab = objWb.QueryTables.Add ("TEXT;"+GetPath + file,
objWb.Range("A1"))
Set objTab = objWb.QueryTables.Add ("TEXT;"+file, objWb.Range("A1"))

' here comes the mumbo jumbo to set all the properties for the wizard
' Oh Microsoft, how do I wish to has a With feature or a possibility to
' pass named arguments to methods ....
objTab.Name = "Names"
objTab.FieldNames = True
objTab.RowNumbers = False
objTab.FillAdjacentFormulas = False
objTab.PreserveFormatting = True
objTab.RefreshOnFileOpen = False
objTab.RefreshStyle = 1 'xlInsertDeleteCells
objTab.SavePassword = False
objTab.SaveData = True
objTab.AdjustColumnWidth = True
objTab.RefreshPeriod = 0
objTab.TextFilePromptOnRefresh = False
objTab.TextFilePlatform = 2 'xlWindows
objTab.TextFileStartRow = 1
objTab.TextFileParseType = 1 'xlDelimited
objTab.TextFileTextQualifier = -4142 ' xlTextQualifierNone
objTab.TextFileConsecutiveDelimiter = False
objTab.TextFileTabDelimiter = False ' ### my delimiters
objTab.TextFileSemicolonDelimiter = True
objTab.TextFileCommaDelimiter = False
objTab.TextFileSpaceDelimiter = False
objTab.TextFileColumnDataTypes Array(1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
objTab.Refresh False

'WScript.Echo "We have loaded the worksheet"

' demonstrate how to read the column header values
Text = "Worksheet " + objWb.name + vbCRLF
Text = Text + "Column titles" + vbCRLF
Text = Text + CStr(objWb.Cells(1, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(1, 2).Value) + vbCRLF

' show some cell values (using the "hard coded method")
Text = Text + CStr(objWb.Cells(2, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(2, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(3, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(3, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(4, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(4, 2).Value) + vbCRLF

'' Show results
'MsgBox Text, vbOkOnly+ vbInformation, Title
'objXL.ActiveSheet.PrintOut ' print Worksheet
'WScript.Echo "We are printing, close after printing"

' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
'WScript.Echo "We are saving now"

'*****Feuil3 ******"
Dim cnn,rs,sql
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data
Source=C:utiKPIKPI01.xls; Extended Properties=""Excel 8.0;HDR=Yes;"";"
rs.Open "SELECT LIG_MAITRE," & _
"sum(case when SEMAINE = 1 then PT else 0 end) as m1," & _
"sum(case when SEMAINE = 2 then PT else 0 end) as m2," & _
"sum(case when SEMAINE = 3 then PT else 0 end) as m3," & _
"sum(case when SEMAINE = 4 then PT else 0 end) as m4," & _
"sum(case when SEMAINE = 5 then PT else 0 end) as m5," & _
"sum(case when SEMAINE = 6 then PT else 0 end) as m6," & _
"sum(case when SEMAINE = 7 then PT else 0 end) as m7," & _
"sum(case when SEMAINE = 8 then PT else 0 end) as m8," & _
"sum(case when SEMAINE = 9 then PT else 0 end) as m9," & _
"sum(case when SEMAINE = 10 then PT else 0 end) as m10," & _
"sum(case when SEMAINE = 11 then PT else 0 end) as m11," & _
"sum(case when SEMAINE = 12 then PT else 0 end) as m12," & _
"sum(case when SEMAINE = 13 then PT else 0 end) as m13," & _
"sum(case when SEMAINE = 14 then PT else 0 end) as m14," & _
"sum(case when SEMAINE = 15 then PT else 0 end) as m15," & _
"sum(case when SEMAINE = 16 then PT else 0 end) as m16," & _
"sum(case when SEMAINE = 17 then PT else 0 end) as m17," & _
"sum(case when SEMAINE = 18 then PT else 0 end) as m18," & _
"sum(case when SEMAINE = 19 then PT else 0 end) as m19," & _
"sum(case when SEMAINE = 20 then PT else 0 end) as m20," & _
"sum(case when SEMAINE = 21 then PT else 0 end) as m21," & _
"sum(case when SEMAINE = 22 then PT else 0 end) as m22," & _
"sum(case when SEMAINE = 23 then PT else 0 end) as m23," & _
"sum(case when SEMAINE = 24 then PT else 0 end) as m24," & _
"sum(case when SEMAINE = 25 then PT else 0 end) as m25," & _
"sum(case when SEMAINE = 26 then PT else 0 end) as m26," & _
"sum(case when SEMAINE = 27 then PT else 0 end) as m27," & _
"sum(case when SEMAINE = 28 then PT else 0 end) as m28," & _
"sum(case when SEMAINE = 29 then PT else 0 end) as m29," & _
"sum(case when SEMAINE = 30 then PT else 0 end) as m30," & _
"sum(case when SEMAINE = 31 then PT else 0 end) as m31," & _
"sum(case when SEMAINE = 32 then PT else 0 end) as m32," & _
"sum(case when SEMAINE = 33 then PT else 0 end) as m33," & _
"sum(case when SEMAINE = 34 then PT else 0 end) as m34" & _
"sum(case when SEMAINE = 35 then PT else 0 end) as m35," & _
"sum(case when SEMAINE = 36 then PT else 0 end) as m36," & _
"sum(case when SEMAINE = 37 then PT else 0 end) as m37," & _
"sum(case when SEMAINE = 38 then PT else 0 end) as m38," & _
"sum(case when SEMAINE = 39 then PT else 0 end) as m39," & _
"sum(case when SEMAINE = 40 then PT else 0 end) as m40," & _
"sum(case when SEMAINE = 41 then PT else 0 end) as m41," & _
"sum(case when SEMAINE = 42 then PT else 0 end) as m42," & _
"sum(case when SEMAINE = 43 then PT else 0 end) as m43," & _
"sum(case when SEMAINE = 44 then PT else 0 end) as m44," & _
"sum(case when SEMAINE = 45 then PT else 0 end) as m45," & _
"sum(case when SEMAINE = 46 then PT else 0 end) as m46," & _
"sum(case when SEMAINE = 47 then PT else 0 end) as m47," & _
"sum(case when SEMAINE = 48 then PT else 0 end) as m48," & _
"sum(case when SEMAINE = 49 then PT else 0 end) as m49," & _
"sum(case when SEMAINE = 50 then PT else 0 end) as m50," & _
"sum(case when SEMAINE = 51 then PT else 0 end) as m51," & _
"sum(case when SEMAINE = 52 then PT else 0 end) as m52," & _
"sum(case when SEMAINE = 53 then PT else 0 end) as m53" & _
"From [Feuil1$] Group BY LIG_MAITRE",cnn,3,3,&H0001
i = 2
Do While Not rs.EOF
objWb3.Cells(i, 1) = rs("LIGNE_MAIT")
objWb3.Cells(i, 2) = rs("M1")
objWb3.Cells(i, 3) = rs("M2")
objWb3.Cells(i, 4) = rs("M3")
objWb3.Cells(i, 5) = rs("M4")
objWb3.Cells(i, 6) = rs("M5")
objWb3.Cells(i, 7) = rs("M6")
objWb3.Cells(i, 8) = rs("M7")
objWb3.Cells(i, 9) = rs("M8")
objWb3.Cells(i, 10) = rs("M9")
objWb3.Cells(i, 11) = rs("M10")
objWb3.Cells(i, 12) = rs("M11")
objWb3.Cells(i, 13) = rs("M12")
objWb3.Cells(i, 14) = rs("M13")
objWb3.Cells(i, 15) = rs("M14")
objWb3.Cells(i, 16) = rs("M15")
objWb3.Cells(i, 17) = rs("M16")
objWb3.Cells(i, 18) = rs("M17")
objWb3.Cells(i, 19) = rs("M18")
objWb3.Cells(i, 20) = rs("M19")
objWb3.Cells(i, 21) = rs("M20")
objWb3.Cells(i, 22) = rs("M21")
objWb3.Cells(i, 23) = rs("M22")
objWb3.Cells(i, 24) = rs("M23")
objWb3.Cells(i, 25) = rs("M24")
objWb3.Cells(i, 26) = rs("M25")
objWb3.Cells(i, 27) = rs("M26")
objWb3.Cells(i, 28) = rs("M27")
objWb3.Cells(i, 29) = rs("M28")
objWb3.Cells(i, 30) = rs("M29")
objWb3.Cells(i, 31) = rs("M30")
objWb3.Cells(i, 32) = rs("M31")
objWb3.Cells(i, 33) = rs("M32")
objWb3.Cells(i, 34) = rs("M33")
objWb3.Cells(i, 35) = rs("M34")
objWb3.Cells(i, 36) = rs("M35")
objWb3.Cells(i, 37) = rs("M36")
objWb3.Cells(i, 38) = rs("M37")
objWb3.Cells(i, 39) = rs("M38")
objWb3.Cells(i, 40) = rs("M39")
objWb3.Cells(i, 41) = rs("M40")
objWb3.Cells(i, 42) = rs("M41")
objWb3.Cells(i, 43) = rs("M42")
objWb3.Cells(i, 44) = rs("M43")
objWb3.Cells(i, 45) = rs("M44")
objWb3.Cells(i, 46) = rs("M45")
objWb3.Cells(i, 47) = rs("M46")
objWb3.Cells(i, 48) = rs("M47")
objWb3.Cells(i, 49) = rs("M48")
objWb3.Cells(i, 50) = rs("M49")
objWb3.Cells(i, 51) = rs("M50")
objWb3.Cells(i, 52) = rs("M51")
objWb3.Cells(i, 53) = rs("M52")
objWb3.Cells(i, 54) = rs("M53")
rs.MoveNext
i = i + 1
Loop
' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
' *********** FIN *******************'
rs.Close
cnn.Close
Set rs = Nothing
' WScript.Echo "We save now"
' save as now again
'FileName = GetPath + "KPI01.xls"
'objXL.ActiveWorkbook.SaveAs FileName
'WScript.Echo "We are saving now"

objXl.Quit() ' Quit Excel
Set objXL = Nothing
WScript.Quit()

'##########################
Function GetPath
' Retrieve the script path
DIM path
path = WScript.ScriptFullName ' Script name
GetPath = Left(path, InstrRev(path, ""))
End Function

Tu dois ajouter à ton classeur à partir de l'interface
de l'éditeur de code la référence suivante :

"Microsoft Activex Data Object 2.x librairy"

et essaie de déclarer tes objets de cette manière pour la section "Feuil3"

Dim cnn As ADODB.Connection, rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open ... la suite

Set rs = New ADODB.Recordset

"Ralf Meuser" <rmeuser@free.fr> a écrit dans le message de news:
46bc8c4b$0$425$426a74cc@news.free.fr...
Salut a tous

J'essai de importer un fichier CSV et de crée une feuille avec un
regroupement de données.

Importations fonctionne maintenant, mais j'ai un problème pour ma requête
SQL.

Merci avance pour tout aide.

Bon week-end

Ralf

----------------------------------------------------
voici mon script
---------------------------------------------------
Option Explicit
Const vbNormal = 1 ' window style

DIM objXL, objWb, objWb2, objWb3, objR, objTab ' Excel object variables
DIM Title, Text, tmp, i, j, file, name, FileName
DIM myString

' here you may set the name of the file to be imported
file = "S:UnifaceKPI01.TXT" ' must be located in the script folder

' create an Excel object reference
Set objXL = WScript.CreateObject ("Excel.Application")

' set the Excel window properties (not absolutely necessary)
objXL.WindowState = vbNormal ' Normal
objXL.Height = 300 ' height
objXL.Width = 400 ' width
objXL.Left = 40 ' X-Position
objXL.Top = 20 ' Y-Position
objXL.Visible = true ' show window

' Create new Workbook (needed for import the CSV file Set objWb = objXl.WorkBooks.Add

' Get the first loaded worksheet object of the current workbook
Set objWb = objXL.ActiveWorkBook.WorkSheets(1)
Set objWb2 = objXL.ActiveWorkBook.WorkSheets(2)
Set objWb3 = objXL.ActiveWorkBook.WorkSheets(3)
objWb.Activate ' not absolutely necessary (for CSV)
' Now invoke the import wizard

'Set objTab = objWb.QueryTables.Add ("TEXT;"+GetPath + file,
objWb.Range("A1"))
Set objTab = objWb.QueryTables.Add ("TEXT;"+file, objWb.Range("A1"))

' here comes the mumbo jumbo to set all the properties for the wizard
' Oh Microsoft, how do I wish to has a With feature or a possibility to
' pass named arguments to methods ....
objTab.Name = "Names"
objTab.FieldNames = True
objTab.RowNumbers = False
objTab.FillAdjacentFormulas = False
objTab.PreserveFormatting = True
objTab.RefreshOnFileOpen = False
objTab.RefreshStyle = 1 'xlInsertDeleteCells
objTab.SavePassword = False
objTab.SaveData = True
objTab.AdjustColumnWidth = True
objTab.RefreshPeriod = 0
objTab.TextFilePromptOnRefresh = False
objTab.TextFilePlatform = 2 'xlWindows
objTab.TextFileStartRow = 1
objTab.TextFileParseType = 1 'xlDelimited
objTab.TextFileTextQualifier = -4142 ' xlTextQualifierNone
objTab.TextFileConsecutiveDelimiter = False
objTab.TextFileTabDelimiter = False ' ### my delimiters
objTab.TextFileSemicolonDelimiter = True
objTab.TextFileCommaDelimiter = False
objTab.TextFileSpaceDelimiter = False
objTab.TextFileColumnDataTypes Array(1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
objTab.Refresh False

'WScript.Echo "We have loaded the worksheet"

' demonstrate how to read the column header values
Text = "Worksheet " + objWb.name + vbCRLF
Text = Text + "Column titles" + vbCRLF
Text = Text + CStr(objWb.Cells(1, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(1, 2).Value) + vbCRLF

' show some cell values (using the "hard coded method")
Text = Text + CStr(objWb.Cells(2, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(2, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(3, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(3, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(4, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(4, 2).Value) + vbCRLF

'' Show results
'MsgBox Text, vbOkOnly+ vbInformation, Title
'objXL.ActiveSheet.PrintOut ' print Worksheet
'WScript.Echo "We are printing, close after printing"

' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
'WScript.Echo "We are saving now"

'*****Feuil3 ******"
Dim cnn,rs,sql
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data
Source=C:utiKPIKPI01.xls; Extended Properties=""Excel 8.0;HDR=Yes;"";"
rs.Open "SELECT LIG_MAITRE," & _
"sum(case when SEMAINE = 1 then PT else 0 end) as m1," & _
"sum(case when SEMAINE = 2 then PT else 0 end) as m2," & _
"sum(case when SEMAINE = 3 then PT else 0 end) as m3," & _
"sum(case when SEMAINE = 4 then PT else 0 end) as m4," & _
"sum(case when SEMAINE = 5 then PT else 0 end) as m5," & _
"sum(case when SEMAINE = 6 then PT else 0 end) as m6," & _
"sum(case when SEMAINE = 7 then PT else 0 end) as m7," & _
"sum(case when SEMAINE = 8 then PT else 0 end) as m8," & _
"sum(case when SEMAINE = 9 then PT else 0 end) as m9," & _
"sum(case when SEMAINE = 10 then PT else 0 end) as m10," & _
"sum(case when SEMAINE = 11 then PT else 0 end) as m11," & _
"sum(case when SEMAINE = 12 then PT else 0 end) as m12," & _
"sum(case when SEMAINE = 13 then PT else 0 end) as m13," & _
"sum(case when SEMAINE = 14 then PT else 0 end) as m14," & _
"sum(case when SEMAINE = 15 then PT else 0 end) as m15," & _
"sum(case when SEMAINE = 16 then PT else 0 end) as m16," & _
"sum(case when SEMAINE = 17 then PT else 0 end) as m17," & _
"sum(case when SEMAINE = 18 then PT else 0 end) as m18," & _
"sum(case when SEMAINE = 19 then PT else 0 end) as m19," & _
"sum(case when SEMAINE = 20 then PT else 0 end) as m20," & _
"sum(case when SEMAINE = 21 then PT else 0 end) as m21," & _
"sum(case when SEMAINE = 22 then PT else 0 end) as m22," & _
"sum(case when SEMAINE = 23 then PT else 0 end) as m23," & _
"sum(case when SEMAINE = 24 then PT else 0 end) as m24," & _
"sum(case when SEMAINE = 25 then PT else 0 end) as m25," & _
"sum(case when SEMAINE = 26 then PT else 0 end) as m26," & _
"sum(case when SEMAINE = 27 then PT else 0 end) as m27," & _
"sum(case when SEMAINE = 28 then PT else 0 end) as m28," & _
"sum(case when SEMAINE = 29 then PT else 0 end) as m29," & _
"sum(case when SEMAINE = 30 then PT else 0 end) as m30," & _
"sum(case when SEMAINE = 31 then PT else 0 end) as m31," & _
"sum(case when SEMAINE = 32 then PT else 0 end) as m32," & _
"sum(case when SEMAINE = 33 then PT else 0 end) as m33," & _
"sum(case when SEMAINE = 34 then PT else 0 end) as m34" & _
"sum(case when SEMAINE = 35 then PT else 0 end) as m35," & _
"sum(case when SEMAINE = 36 then PT else 0 end) as m36," & _
"sum(case when SEMAINE = 37 then PT else 0 end) as m37," & _
"sum(case when SEMAINE = 38 then PT else 0 end) as m38," & _
"sum(case when SEMAINE = 39 then PT else 0 end) as m39," & _
"sum(case when SEMAINE = 40 then PT else 0 end) as m40," & _
"sum(case when SEMAINE = 41 then PT else 0 end) as m41," & _
"sum(case when SEMAINE = 42 then PT else 0 end) as m42," & _
"sum(case when SEMAINE = 43 then PT else 0 end) as m43," & _
"sum(case when SEMAINE = 44 then PT else 0 end) as m44," & _
"sum(case when SEMAINE = 45 then PT else 0 end) as m45," & _
"sum(case when SEMAINE = 46 then PT else 0 end) as m46," & _
"sum(case when SEMAINE = 47 then PT else 0 end) as m47," & _
"sum(case when SEMAINE = 48 then PT else 0 end) as m48," & _
"sum(case when SEMAINE = 49 then PT else 0 end) as m49," & _
"sum(case when SEMAINE = 50 then PT else 0 end) as m50," & _
"sum(case when SEMAINE = 51 then PT else 0 end) as m51," & _
"sum(case when SEMAINE = 52 then PT else 0 end) as m52," & _
"sum(case when SEMAINE = 53 then PT else 0 end) as m53" & _
"From [Feuil1$] Group BY LIG_MAITRE",cnn,3,3,&H0001
i = 2
Do While Not rs.EOF
objWb3.Cells(i, 1) = rs("LIGNE_MAIT")
objWb3.Cells(i, 2) = rs("M1")
objWb3.Cells(i, 3) = rs("M2")
objWb3.Cells(i, 4) = rs("M3")
objWb3.Cells(i, 5) = rs("M4")
objWb3.Cells(i, 6) = rs("M5")
objWb3.Cells(i, 7) = rs("M6")
objWb3.Cells(i, 8) = rs("M7")
objWb3.Cells(i, 9) = rs("M8")
objWb3.Cells(i, 10) = rs("M9")
objWb3.Cells(i, 11) = rs("M10")
objWb3.Cells(i, 12) = rs("M11")
objWb3.Cells(i, 13) = rs("M12")
objWb3.Cells(i, 14) = rs("M13")
objWb3.Cells(i, 15) = rs("M14")
objWb3.Cells(i, 16) = rs("M15")
objWb3.Cells(i, 17) = rs("M16")
objWb3.Cells(i, 18) = rs("M17")
objWb3.Cells(i, 19) = rs("M18")
objWb3.Cells(i, 20) = rs("M19")
objWb3.Cells(i, 21) = rs("M20")
objWb3.Cells(i, 22) = rs("M21")
objWb3.Cells(i, 23) = rs("M22")
objWb3.Cells(i, 24) = rs("M23")
objWb3.Cells(i, 25) = rs("M24")
objWb3.Cells(i, 26) = rs("M25")
objWb3.Cells(i, 27) = rs("M26")
objWb3.Cells(i, 28) = rs("M27")
objWb3.Cells(i, 29) = rs("M28")
objWb3.Cells(i, 30) = rs("M29")
objWb3.Cells(i, 31) = rs("M30")
objWb3.Cells(i, 32) = rs("M31")
objWb3.Cells(i, 33) = rs("M32")
objWb3.Cells(i, 34) = rs("M33")
objWb3.Cells(i, 35) = rs("M34")
objWb3.Cells(i, 36) = rs("M35")
objWb3.Cells(i, 37) = rs("M36")
objWb3.Cells(i, 38) = rs("M37")
objWb3.Cells(i, 39) = rs("M38")
objWb3.Cells(i, 40) = rs("M39")
objWb3.Cells(i, 41) = rs("M40")
objWb3.Cells(i, 42) = rs("M41")
objWb3.Cells(i, 43) = rs("M42")
objWb3.Cells(i, 44) = rs("M43")
objWb3.Cells(i, 45) = rs("M44")
objWb3.Cells(i, 46) = rs("M45")
objWb3.Cells(i, 47) = rs("M46")
objWb3.Cells(i, 48) = rs("M47")
objWb3.Cells(i, 49) = rs("M48")
objWb3.Cells(i, 50) = rs("M49")
objWb3.Cells(i, 51) = rs("M50")
objWb3.Cells(i, 52) = rs("M51")
objWb3.Cells(i, 53) = rs("M52")
objWb3.Cells(i, 54) = rs("M53")
rs.MoveNext
i = i + 1
Loop
' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
' *********** FIN *******************'
rs.Close
cnn.Close
Set rs = Nothing
' WScript.Echo "We save now"
' save as now again
'FileName = GetPath + "KPI01.xls"
'objXL.ActiveWorkbook.SaveAs FileName
'WScript.Echo "We are saving now"

objXl.Quit() ' Quit Excel
Set objXL = Nothing
WScript.Quit()

'##########################
Function GetPath
' Retrieve the script path
DIM path
path = WScript.ScriptFullName ' Script name
GetPath = Left(path, InstrRev(path, ""))
End Function

Vous avez filtré cet utilisateur ! Consultez son message

Tu dois ajouter à ton classeur à partir de l'interface
de l'éditeur de code la référence suivante :

"Microsoft Activex Data Object 2.x librairy"

et essaie de déclarer tes objets de cette manière pour la section "Feuil3"

Dim cnn As ADODB.Connection, rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open ... la suite

Set rs = New ADODB.Recordset

"Ralf Meuser" a écrit dans le message de news:
46bc8c4b$0$425$
Salut a tous

J'essai de importer un fichier CSV et de crée une feuille avec un
regroupement de données.

Importations fonctionne maintenant, mais j'ai un problème pour ma requête
SQL.

Merci avance pour tout aide.

Bon week-end

Ralf

----------------------------------------------------
voici mon script
---------------------------------------------------
Option Explicit
Const vbNormal = 1 ' window style

DIM objXL, objWb, objWb2, objWb3, objR, objTab ' Excel object variables
DIM Title, Text, tmp, i, j, file, name, FileName
DIM myString

' here you may set the name of the file to be imported
file = "S:UnifaceKPI01.TXT" ' must be located in the script folder

' create an Excel object reference
Set objXL = WScript.CreateObject ("Excel.Application")

' set the Excel window properties (not absolutely necessary)
objXL.WindowState = vbNormal ' Normal
objXL.Height = 300 ' height
objXL.Width = 400 ' width
objXL.Left = 40 ' X-Position
objXL.Top = 20 ' Y-Position
objXL.Visible = true ' show window

' Create new Workbook (needed for import the CSV file Set objWb = objXl.WorkBooks.Add

' Get the first loaded worksheet object of the current workbook
Set objWb = objXL.ActiveWorkBook.WorkSheets(1)
Set objWb2 = objXL.ActiveWorkBook.WorkSheets(2)
Set objWb3 = objXL.ActiveWorkBook.WorkSheets(3)
objWb.Activate ' not absolutely necessary (for CSV)
' Now invoke the import wizard

'Set objTab = objWb.QueryTables.Add ("TEXT;"+GetPath + file,
objWb.Range("A1"))
Set objTab = objWb.QueryTables.Add ("TEXT;"+file, objWb.Range("A1"))

' here comes the mumbo jumbo to set all the properties for the wizard
' Oh Microsoft, how do I wish to has a With feature or a possibility to
' pass named arguments to methods ....
objTab.Name = "Names"
objTab.FieldNames = True
objTab.RowNumbers = False
objTab.FillAdjacentFormulas = False
objTab.PreserveFormatting = True
objTab.RefreshOnFileOpen = False
objTab.RefreshStyle = 1 'xlInsertDeleteCells
objTab.SavePassword = False
objTab.SaveData = True
objTab.AdjustColumnWidth = True
objTab.RefreshPeriod = 0
objTab.TextFilePromptOnRefresh = False
objTab.TextFilePlatform = 2 'xlWindows
objTab.TextFileStartRow = 1
objTab.TextFileParseType = 1 'xlDelimited
objTab.TextFileTextQualifier = -4142 ' xlTextQualifierNone
objTab.TextFileConsecutiveDelimiter = False
objTab.TextFileTabDelimiter = False ' ### my delimiters
objTab.TextFileSemicolonDelimiter = True
objTab.TextFileCommaDelimiter = False
objTab.TextFileSpaceDelimiter = False
objTab.TextFileColumnDataTypes Array(1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
objTab.Refresh False

'WScript.Echo "We have loaded the worksheet"

' demonstrate how to read the column header values
Text = "Worksheet " + objWb.name + vbCRLF
Text = Text + "Column titles" + vbCRLF
Text = Text + CStr(objWb.Cells(1, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(1, 2).Value) + vbCRLF

' show some cell values (using the "hard coded method")
Text = Text + CStr(objWb.Cells(2, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(2, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(3, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(3, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(4, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(4, 2).Value) + vbCRLF

'' Show results
'MsgBox Text, vbOkOnly+ vbInformation, Title
'objXL.ActiveSheet.PrintOut ' print Worksheet
'WScript.Echo "We are printing, close after printing"

' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
'WScript.Echo "We are saving now"

'*****Feuil3 ******"
Dim cnn,rs,sql
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data
Source=C:utiKPIKPI01.xls; Extended Properties=""Excel 8.0;HDR=Yes;"";"
rs.Open "SELECT LIG_MAITRE," & _
"sum(case when SEMAINE = 1 then PT else 0 end) as m1," & _
"sum(case when SEMAINE = 2 then PT else 0 end) as m2," & _
"sum(case when SEMAINE = 3 then PT else 0 end) as m3," & _
"sum(case when SEMAINE = 4 then PT else 0 end) as m4," & _
"sum(case when SEMAINE = 5 then PT else 0 end) as m5," & _
"sum(case when SEMAINE = 6 then PT else 0 end) as m6," & _
"sum(case when SEMAINE = 7 then PT else 0 end) as m7," & _
"sum(case when SEMAINE = 8 then PT else 0 end) as m8," & _
"sum(case when SEMAINE = 9 then PT else 0 end) as m9," & _
"sum(case when SEMAINE = 10 then PT else 0 end) as m10," & _
"sum(case when SEMAINE = 11 then PT else 0 end) as m11," & _
"sum(case when SEMAINE = 12 then PT else 0 end) as m12," & _
"sum(case when SEMAINE = 13 then PT else 0 end) as m13," & _
"sum(case when SEMAINE = 14 then PT else 0 end) as m14," & _
"sum(case when SEMAINE = 15 then PT else 0 end) as m15," & _
"sum(case when SEMAINE = 16 then PT else 0 end) as m16," & _
"sum(case when SEMAINE = 17 then PT else 0 end) as m17," & _
"sum(case when SEMAINE = 18 then PT else 0 end) as m18," & _
"sum(case when SEMAINE = 19 then PT else 0 end) as m19," & _
"sum(case when SEMAINE = 20 then PT else 0 end) as m20," & _
"sum(case when SEMAINE = 21 then PT else 0 end) as m21," & _
"sum(case when SEMAINE = 22 then PT else 0 end) as m22," & _
"sum(case when SEMAINE = 23 then PT else 0 end) as m23," & _
"sum(case when SEMAINE = 24 then PT else 0 end) as m24," & _
"sum(case when SEMAINE = 25 then PT else 0 end) as m25," & _
"sum(case when SEMAINE = 26 then PT else 0 end) as m26," & _
"sum(case when SEMAINE = 27 then PT else 0 end) as m27," & _
"sum(case when SEMAINE = 28 then PT else 0 end) as m28," & _
"sum(case when SEMAINE = 29 then PT else 0 end) as m29," & _
"sum(case when SEMAINE = 30 then PT else 0 end) as m30," & _
"sum(case when SEMAINE = 31 then PT else 0 end) as m31," & _
"sum(case when SEMAINE = 32 then PT else 0 end) as m32," & _
"sum(case when SEMAINE = 33 then PT else 0 end) as m33," & _
"sum(case when SEMAINE = 34 then PT else 0 end) as m34" & _
"sum(case when SEMAINE = 35 then PT else 0 end) as m35," & _
"sum(case when SEMAINE = 36 then PT else 0 end) as m36," & _
"sum(case when SEMAINE = 37 then PT else 0 end) as m37," & _
"sum(case when SEMAINE = 38 then PT else 0 end) as m38," & _
"sum(case when SEMAINE = 39 then PT else 0 end) as m39," & _
"sum(case when SEMAINE = 40 then PT else 0 end) as m40," & _
"sum(case when SEMAINE = 41 then PT else 0 end) as m41," & _
"sum(case when SEMAINE = 42 then PT else 0 end) as m42," & _
"sum(case when SEMAINE = 43 then PT else 0 end) as m43," & _
"sum(case when SEMAINE = 44 then PT else 0 end) as m44," & _
"sum(case when SEMAINE = 45 then PT else 0 end) as m45," & _
"sum(case when SEMAINE = 46 then PT else 0 end) as m46," & _
"sum(case when SEMAINE = 47 then PT else 0 end) as m47," & _
"sum(case when SEMAINE = 48 then PT else 0 end) as m48," & _
"sum(case when SEMAINE = 49 then PT else 0 end) as m49," & _
"sum(case when SEMAINE = 50 then PT else 0 end) as m50," & _
"sum(case when SEMAINE = 51 then PT else 0 end) as m51," & _
"sum(case when SEMAINE = 52 then PT else 0 end) as m52," & _
"sum(case when SEMAINE = 53 then PT else 0 end) as m53" & _
"From [Feuil1$] Group BY LIG_MAITRE",cnn,3,3,&H0001
i = 2
Do While Not rs.EOF
objWb3.Cells(i, 1) = rs("LIGNE_MAIT")
objWb3.Cells(i, 2) = rs("M1")
objWb3.Cells(i, 3) = rs("M2")
objWb3.Cells(i, 4) = rs("M3")
objWb3.Cells(i, 5) = rs("M4")
objWb3.Cells(i, 6) = rs("M5")
objWb3.Cells(i, 7) = rs("M6")
objWb3.Cells(i, 8) = rs("M7")
objWb3.Cells(i, 9) = rs("M8")
objWb3.Cells(i, 10) = rs("M9")
objWb3.Cells(i, 11) = rs("M10")
objWb3.Cells(i, 12) = rs("M11")
objWb3.Cells(i, 13) = rs("M12")
objWb3.Cells(i, 14) = rs("M13")
objWb3.Cells(i, 15) = rs("M14")
objWb3.Cells(i, 16) = rs("M15")
objWb3.Cells(i, 17) = rs("M16")
objWb3.Cells(i, 18) = rs("M17")
objWb3.Cells(i, 19) = rs("M18")
objWb3.Cells(i, 20) = rs("M19")
objWb3.Cells(i, 21) = rs("M20")
objWb3.Cells(i, 22) = rs("M21")
objWb3.Cells(i, 23) = rs("M22")
objWb3.Cells(i, 24) = rs("M23")
objWb3.Cells(i, 25) = rs("M24")
objWb3.Cells(i, 26) = rs("M25")
objWb3.Cells(i, 27) = rs("M26")
objWb3.Cells(i, 28) = rs("M27")
objWb3.Cells(i, 29) = rs("M28")
objWb3.Cells(i, 30) = rs("M29")
objWb3.Cells(i, 31) = rs("M30")
objWb3.Cells(i, 32) = rs("M31")
objWb3.Cells(i, 33) = rs("M32")
objWb3.Cells(i, 34) = rs("M33")
objWb3.Cells(i, 35) = rs("M34")
objWb3.Cells(i, 36) = rs("M35")
objWb3.Cells(i, 37) = rs("M36")
objWb3.Cells(i, 38) = rs("M37")
objWb3.Cells(i, 39) = rs("M38")
objWb3.Cells(i, 40) = rs("M39")
objWb3.Cells(i, 41) = rs("M40")
objWb3.Cells(i, 42) = rs("M41")
objWb3.Cells(i, 43) = rs("M42")
objWb3.Cells(i, 44) = rs("M43")
objWb3.Cells(i, 45) = rs("M44")
objWb3.Cells(i, 46) = rs("M45")
objWb3.Cells(i, 47) = rs("M46")
objWb3.Cells(i, 48) = rs("M47")
objWb3.Cells(i, 49) = rs("M48")
objWb3.Cells(i, 50) = rs("M49")
objWb3.Cells(i, 51) = rs("M50")
objWb3.Cells(i, 52) = rs("M51")
objWb3.Cells(i, 53) = rs("M52")
objWb3.Cells(i, 54) = rs("M53")
rs.MoveNext
i = i + 1
Loop
' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
' *********** FIN *******************'
rs.Close
cnn.Close
Set rs = Nothing
' WScript.Echo "We save now"
' save as now again
'FileName = GetPath + "KPI01.xls"
'objXL.ActiveWorkbook.SaveAs FileName
'WScript.Echo "We are saving now"

objXl.Quit() ' Quit Excel
Set objXL = Nothing
WScript.Quit()

'##########################
Function GetPath
' Retrieve the script path
DIM path
path = WScript.ScriptFullName ' Script name
GetPath = Left(path, InstrRev(path, ""))
End Function

MichDenis

10/08/2007 à 19:26

Un petit détail important, si ta version Excel est plus ancienne
qu'excel 2002, quand tu ouvres un classeur par automation
dans une nouvelle instance d'excel, tu dois ajouter par programmation
la référence mentionnée même si elle est présente lorsque tu ouvres
ton classeur normalement. Ce n'est pas le cas pour les versions
excel 2002 et 2003.

Pour vérifier la présence de la référence, tu rends l'application Excel
créé par automation visible et tu vérifies si la référence est bien présente.

"MichDenis" a écrit dans le message de news:

Tu dois ajouter à ton classeur à partir de l'interface
de l'éditeur de code la référence suivante :

"Microsoft Activex Data Object 2.x librairy"

et essaie de déclarer tes objets de cette manière pour la section "Feuil3"

Dim cnn As ADODB.Connection, rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open ... la suite

Set rs = New ADODB.Recordset

"Ralf Meuser" a écrit dans le message de news:
46bc8c4b$0$425$
Salut a tous

J'essai de importer un fichier CSV et de crée une feuille avec un
regroupement de données.

Importations fonctionne maintenant, mais j'ai un problème pour ma requête
SQL.

Merci avance pour tout aide.

Bon week-end

Ralf

----------------------------------------------------
voici mon script
---------------------------------------------------
Option Explicit
Const vbNormal = 1 ' window style

DIM objXL, objWb, objWb2, objWb3, objR, objTab ' Excel object variables
DIM Title, Text, tmp, i, j, file, name, FileName
DIM myString

' here you may set the name of the file to be imported
file = "S:UnifaceKPI01.TXT" ' must be located in the script folder

' create an Excel object reference
Set objXL = WScript.CreateObject ("Excel.Application")

' set the Excel window properties (not absolutely necessary)
objXL.WindowState = vbNormal ' Normal
objXL.Height = 300 ' height
objXL.Width = 400 ' width
objXL.Left = 40 ' X-Position
objXL.Top = 20 ' Y-Position
objXL.Visible = true ' show window

' Create new Workbook (needed for import the CSV file Set objWb = objXl.WorkBooks.Add

' Get the first loaded worksheet object of the current workbook
Set objWb = objXL.ActiveWorkBook.WorkSheets(1)
Set objWb2 = objXL.ActiveWorkBook.WorkSheets(2)
Set objWb3 = objXL.ActiveWorkBook.WorkSheets(3)
objWb.Activate ' not absolutely necessary (for CSV)
' Now invoke the import wizard

'Set objTab = objWb.QueryTables.Add ("TEXT;"+GetPath + file,
objWb.Range("A1"))
Set objTab = objWb.QueryTables.Add ("TEXT;"+file, objWb.Range("A1"))

' here comes the mumbo jumbo to set all the properties for the wizard
' Oh Microsoft, how do I wish to has a With feature or a possibility to
' pass named arguments to methods ....
objTab.Name = "Names"
objTab.FieldNames = True
objTab.RowNumbers = False
objTab.FillAdjacentFormulas = False
objTab.PreserveFormatting = True
objTab.RefreshOnFileOpen = False
objTab.RefreshStyle = 1 'xlInsertDeleteCells
objTab.SavePassword = False
objTab.SaveData = True
objTab.AdjustColumnWidth = True
objTab.RefreshPeriod = 0
objTab.TextFilePromptOnRefresh = False
objTab.TextFilePlatform = 2 'xlWindows
objTab.TextFileStartRow = 1
objTab.TextFileParseType = 1 'xlDelimited
objTab.TextFileTextQualifier = -4142 ' xlTextQualifierNone
objTab.TextFileConsecutiveDelimiter = False
objTab.TextFileTabDelimiter = False ' ### my delimiters
objTab.TextFileSemicolonDelimiter = True
objTab.TextFileCommaDelimiter = False
objTab.TextFileSpaceDelimiter = False
objTab.TextFileColumnDataTypes Array(1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
objTab.Refresh False

'WScript.Echo "We have loaded the worksheet"

' demonstrate how to read the column header values
Text = "Worksheet " + objWb.name + vbCRLF
Text = Text + "Column titles" + vbCRLF
Text = Text + CStr(objWb.Cells(1, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(1, 2).Value) + vbCRLF

' show some cell values (using the "hard coded method")
Text = Text + CStr(objWb.Cells(2, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(2, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(3, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(3, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(4, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(4, 2).Value) + vbCRLF

'' Show results
'MsgBox Text, vbOkOnly+ vbInformation, Title
'objXL.ActiveSheet.PrintOut ' print Worksheet
'WScript.Echo "We are printing, close after printing"

' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
'WScript.Echo "We are saving now"

'*****Feuil3 ******"
Dim cnn,rs,sql
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data
Source=C:utiKPIKPI01.xls; Extended Properties=""Excel 8.0;HDR=Yes;"";"
rs.Open "SELECT LIG_MAITRE," & _
"sum(case when SEMAINE = 1 then PT else 0 end) as m1," & _
"sum(case when SEMAINE = 2 then PT else 0 end) as m2," & _
"sum(case when SEMAINE = 3 then PT else 0 end) as m3," & _
"sum(case when SEMAINE = 4 then PT else 0 end) as m4," & _
"sum(case when SEMAINE = 5 then PT else 0 end) as m5," & _
"sum(case when SEMAINE = 6 then PT else 0 end) as m6," & _
"sum(case when SEMAINE = 7 then PT else 0 end) as m7," & _
"sum(case when SEMAINE = 8 then PT else 0 end) as m8," & _
"sum(case when SEMAINE = 9 then PT else 0 end) as m9," & _
"sum(case when SEMAINE = 10 then PT else 0 end) as m10," & _
"sum(case when SEMAINE = 11 then PT else 0 end) as m11," & _
"sum(case when SEMAINE = 12 then PT else 0 end) as m12," & _
"sum(case when SEMAINE = 13 then PT else 0 end) as m13," & _
"sum(case when SEMAINE = 14 then PT else 0 end) as m14," & _
"sum(case when SEMAINE = 15 then PT else 0 end) as m15," & _
"sum(case when SEMAINE = 16 then PT else 0 end) as m16," & _
"sum(case when SEMAINE = 17 then PT else 0 end) as m17," & _
"sum(case when SEMAINE = 18 then PT else 0 end) as m18," & _
"sum(case when SEMAINE = 19 then PT else 0 end) as m19," & _
"sum(case when SEMAINE = 20 then PT else 0 end) as m20," & _
"sum(case when SEMAINE = 21 then PT else 0 end) as m21," & _
"sum(case when SEMAINE = 22 then PT else 0 end) as m22," & _
"sum(case when SEMAINE = 23 then PT else 0 end) as m23," & _
"sum(case when SEMAINE = 24 then PT else 0 end) as m24," & _
"sum(case when SEMAINE = 25 then PT else 0 end) as m25," & _
"sum(case when SEMAINE = 26 then PT else 0 end) as m26," & _
"sum(case when SEMAINE = 27 then PT else 0 end) as m27," & _
"sum(case when SEMAINE = 28 then PT else 0 end) as m28," & _
"sum(case when SEMAINE = 29 then PT else 0 end) as m29," & _
"sum(case when SEMAINE = 30 then PT else 0 end) as m30," & _
"sum(case when SEMAINE = 31 then PT else 0 end) as m31," & _
"sum(case when SEMAINE = 32 then PT else 0 end) as m32," & _
"sum(case when SEMAINE = 33 then PT else 0 end) as m33," & _
"sum(case when SEMAINE = 34 then PT else 0 end) as m34" & _
"sum(case when SEMAINE = 35 then PT else 0 end) as m35," & _
"sum(case when SEMAINE = 36 then PT else 0 end) as m36," & _
"sum(case when SEMAINE = 37 then PT else 0 end) as m37," & _
"sum(case when SEMAINE = 38 then PT else 0 end) as m38," & _
"sum(case when SEMAINE = 39 then PT else 0 end) as m39," & _
"sum(case when SEMAINE = 40 then PT else 0 end) as m40," & _
"sum(case when SEMAINE = 41 then PT else 0 end) as m41," & _
"sum(case when SEMAINE = 42 then PT else 0 end) as m42," & _
"sum(case when SEMAINE = 43 then PT else 0 end) as m43," & _
"sum(case when SEMAINE = 44 then PT else 0 end) as m44," & _
"sum(case when SEMAINE = 45 then PT else 0 end) as m45," & _
"sum(case when SEMAINE = 46 then PT else 0 end) as m46," & _
"sum(case when SEMAINE = 47 then PT else 0 end) as m47," & _
"sum(case when SEMAINE = 48 then PT else 0 end) as m48," & _
"sum(case when SEMAINE = 49 then PT else 0 end) as m49," & _
"sum(case when SEMAINE = 50 then PT else 0 end) as m50," & _
"sum(case when SEMAINE = 51 then PT else 0 end) as m51," & _
"sum(case when SEMAINE = 52 then PT else 0 end) as m52," & _
"sum(case when SEMAINE = 53 then PT else 0 end) as m53" & _
"From [Feuil1$] Group BY LIG_MAITRE",cnn,3,3,&H0001
i = 2
Do While Not rs.EOF
objWb3.Cells(i, 1) = rs("LIGNE_MAIT")
objWb3.Cells(i, 2) = rs("M1")
objWb3.Cells(i, 3) = rs("M2")
objWb3.Cells(i, 4) = rs("M3")
objWb3.Cells(i, 5) = rs("M4")
objWb3.Cells(i, 6) = rs("M5")
objWb3.Cells(i, 7) = rs("M6")
objWb3.Cells(i, 8) = rs("M7")
objWb3.Cells(i, 9) = rs("M8")
objWb3.Cells(i, 10) = rs("M9")
objWb3.Cells(i, 11) = rs("M10")
objWb3.Cells(i, 12) = rs("M11")
objWb3.Cells(i, 13) = rs("M12")
objWb3.Cells(i, 14) = rs("M13")
objWb3.Cells(i, 15) = rs("M14")
objWb3.Cells(i, 16) = rs("M15")
objWb3.Cells(i, 17) = rs("M16")
objWb3.Cells(i, 18) = rs("M17")
objWb3.Cells(i, 19) = rs("M18")
objWb3.Cells(i, 20) = rs("M19")
objWb3.Cells(i, 21) = rs("M20")
objWb3.Cells(i, 22) = rs("M21")
objWb3.Cells(i, 23) = rs("M22")
objWb3.Cells(i, 24) = rs("M23")
objWb3.Cells(i, 25) = rs("M24")
objWb3.Cells(i, 26) = rs("M25")
objWb3.Cells(i, 27) = rs("M26")
objWb3.Cells(i, 28) = rs("M27")
objWb3.Cells(i, 29) = rs("M28")
objWb3.Cells(i, 30) = rs("M29")
objWb3.Cells(i, 31) = rs("M30")
objWb3.Cells(i, 32) = rs("M31")
objWb3.Cells(i, 33) = rs("M32")
objWb3.Cells(i, 34) = rs("M33")
objWb3.Cells(i, 35) = rs("M34")
objWb3.Cells(i, 36) = rs("M35")
objWb3.Cells(i, 37) = rs("M36")
objWb3.Cells(i, 38) = rs("M37")
objWb3.Cells(i, 39) = rs("M38")
objWb3.Cells(i, 40) = rs("M39")
objWb3.Cells(i, 41) = rs("M40")
objWb3.Cells(i, 42) = rs("M41")
objWb3.Cells(i, 43) = rs("M42")
objWb3.Cells(i, 44) = rs("M43")
objWb3.Cells(i, 45) = rs("M44")
objWb3.Cells(i, 46) = rs("M45")
objWb3.Cells(i, 47) = rs("M46")
objWb3.Cells(i, 48) = rs("M47")
objWb3.Cells(i, 49) = rs("M48")
objWb3.Cells(i, 50) = rs("M49")
objWb3.Cells(i, 51) = rs("M50")
objWb3.Cells(i, 52) = rs("M51")
objWb3.Cells(i, 53) = rs("M52")
objWb3.Cells(i, 54) = rs("M53")
rs.MoveNext
i = i + 1
Loop
' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
' *********** FIN *******************'
rs.Close
cnn.Close
Set rs = Nothing
' WScript.Echo "We save now"
' save as now again
'FileName = GetPath + "KPI01.xls"
'objXL.ActiveWorkbook.SaveAs FileName
'WScript.Echo "We are saving now"

objXl.Quit() ' Quit Excel
Set objXL = Nothing
WScript.Quit()

'##########################
Function GetPath
' Retrieve the script path
DIM path
path = WScript.ScriptFullName ' Script name
GetPath = Left(path, InstrRev(path, ""))
End Function

Un petit détail important, si ta version Excel est plus ancienne
qu'excel 2002, quand tu ouvres un classeur par automation
dans une nouvelle instance d'excel, tu dois ajouter par programmation
la référence mentionnée même si elle est présente lorsque tu ouvres
ton classeur normalement. Ce n'est pas le cas pour les versions
excel 2002 et 2003.

Pour vérifier la présence de la référence, tu rends l'application Excel
créé par automation visible et tu vérifies si la référence est bien présente.

"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
eLzJGJ32HHA.1484@TK2MSFTNGP06.phx.gbl...
Tu dois ajouter à ton classeur à partir de l'interface
de l'éditeur de code la référence suivante :

"Microsoft Activex Data Object 2.x librairy"

et essaie de déclarer tes objets de cette manière pour la section "Feuil3"

Dim cnn As ADODB.Connection, rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open ... la suite

Set rs = New ADODB.Recordset

"Ralf Meuser" <rmeuser@free.fr> a écrit dans le message de news:
46bc8c4b$0$425$426a74cc@news.free.fr...
Salut a tous

J'essai de importer un fichier CSV et de crée une feuille avec un
regroupement de données.

Importations fonctionne maintenant, mais j'ai un problème pour ma requête
SQL.

Merci avance pour tout aide.

Bon week-end

Ralf

----------------------------------------------------
voici mon script
---------------------------------------------------
Option Explicit
Const vbNormal = 1 ' window style

DIM objXL, objWb, objWb2, objWb3, objR, objTab ' Excel object variables
DIM Title, Text, tmp, i, j, file, name, FileName
DIM myString

' here you may set the name of the file to be imported
file = "S:UnifaceKPI01.TXT" ' must be located in the script folder

' create an Excel object reference
Set objXL = WScript.CreateObject ("Excel.Application")

' set the Excel window properties (not absolutely necessary)
objXL.WindowState = vbNormal ' Normal
objXL.Height = 300 ' height
objXL.Width = 400 ' width
objXL.Left = 40 ' X-Position
objXL.Top = 20 ' Y-Position
objXL.Visible = true ' show window

' Create new Workbook (needed for import the CSV file Set objWb = objXl.WorkBooks.Add

' Get the first loaded worksheet object of the current workbook
Set objWb = objXL.ActiveWorkBook.WorkSheets(1)
Set objWb2 = objXL.ActiveWorkBook.WorkSheets(2)
Set objWb3 = objXL.ActiveWorkBook.WorkSheets(3)
objWb.Activate ' not absolutely necessary (for CSV)
' Now invoke the import wizard

'Set objTab = objWb.QueryTables.Add ("TEXT;"+GetPath + file,
objWb.Range("A1"))
Set objTab = objWb.QueryTables.Add ("TEXT;"+file, objWb.Range("A1"))

' here comes the mumbo jumbo to set all the properties for the wizard
' Oh Microsoft, how do I wish to has a With feature or a possibility to
' pass named arguments to methods ....
objTab.Name = "Names"
objTab.FieldNames = True
objTab.RowNumbers = False
objTab.FillAdjacentFormulas = False
objTab.PreserveFormatting = True
objTab.RefreshOnFileOpen = False
objTab.RefreshStyle = 1 'xlInsertDeleteCells
objTab.SavePassword = False
objTab.SaveData = True
objTab.AdjustColumnWidth = True
objTab.RefreshPeriod = 0
objTab.TextFilePromptOnRefresh = False
objTab.TextFilePlatform = 2 'xlWindows
objTab.TextFileStartRow = 1
objTab.TextFileParseType = 1 'xlDelimited
objTab.TextFileTextQualifier = -4142 ' xlTextQualifierNone
objTab.TextFileConsecutiveDelimiter = False
objTab.TextFileTabDelimiter = False ' ### my delimiters
objTab.TextFileSemicolonDelimiter = True
objTab.TextFileCommaDelimiter = False
objTab.TextFileSpaceDelimiter = False
objTab.TextFileColumnDataTypes Array(1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
objTab.Refresh False

'WScript.Echo "We have loaded the worksheet"

' demonstrate how to read the column header values
Text = "Worksheet " + objWb.name + vbCRLF
Text = Text + "Column titles" + vbCRLF
Text = Text + CStr(objWb.Cells(1, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(1, 2).Value) + vbCRLF

' show some cell values (using the "hard coded method")
Text = Text + CStr(objWb.Cells(2, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(2, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(3, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(3, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(4, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(4, 2).Value) + vbCRLF

'' Show results
'MsgBox Text, vbOkOnly+ vbInformation, Title
'objXL.ActiveSheet.PrintOut ' print Worksheet
'WScript.Echo "We are printing, close after printing"

' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
'WScript.Echo "We are saving now"

'*****Feuil3 ******"
Dim cnn,rs,sql
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data
Source=C:utiKPIKPI01.xls; Extended Properties=""Excel 8.0;HDR=Yes;"";"
rs.Open "SELECT LIG_MAITRE," & _
"sum(case when SEMAINE = 1 then PT else 0 end) as m1," & _
"sum(case when SEMAINE = 2 then PT else 0 end) as m2," & _
"sum(case when SEMAINE = 3 then PT else 0 end) as m3," & _
"sum(case when SEMAINE = 4 then PT else 0 end) as m4," & _
"sum(case when SEMAINE = 5 then PT else 0 end) as m5," & _
"sum(case when SEMAINE = 6 then PT else 0 end) as m6," & _
"sum(case when SEMAINE = 7 then PT else 0 end) as m7," & _
"sum(case when SEMAINE = 8 then PT else 0 end) as m8," & _
"sum(case when SEMAINE = 9 then PT else 0 end) as m9," & _
"sum(case when SEMAINE = 10 then PT else 0 end) as m10," & _
"sum(case when SEMAINE = 11 then PT else 0 end) as m11," & _
"sum(case when SEMAINE = 12 then PT else 0 end) as m12," & _
"sum(case when SEMAINE = 13 then PT else 0 end) as m13," & _
"sum(case when SEMAINE = 14 then PT else 0 end) as m14," & _
"sum(case when SEMAINE = 15 then PT else 0 end) as m15," & _
"sum(case when SEMAINE = 16 then PT else 0 end) as m16," & _
"sum(case when SEMAINE = 17 then PT else 0 end) as m17," & _
"sum(case when SEMAINE = 18 then PT else 0 end) as m18," & _
"sum(case when SEMAINE = 19 then PT else 0 end) as m19," & _
"sum(case when SEMAINE = 20 then PT else 0 end) as m20," & _
"sum(case when SEMAINE = 21 then PT else 0 end) as m21," & _
"sum(case when SEMAINE = 22 then PT else 0 end) as m22," & _
"sum(case when SEMAINE = 23 then PT else 0 end) as m23," & _
"sum(case when SEMAINE = 24 then PT else 0 end) as m24," & _
"sum(case when SEMAINE = 25 then PT else 0 end) as m25," & _
"sum(case when SEMAINE = 26 then PT else 0 end) as m26," & _
"sum(case when SEMAINE = 27 then PT else 0 end) as m27," & _
"sum(case when SEMAINE = 28 then PT else 0 end) as m28," & _
"sum(case when SEMAINE = 29 then PT else 0 end) as m29," & _
"sum(case when SEMAINE = 30 then PT else 0 end) as m30," & _
"sum(case when SEMAINE = 31 then PT else 0 end) as m31," & _
"sum(case when SEMAINE = 32 then PT else 0 end) as m32," & _
"sum(case when SEMAINE = 33 then PT else 0 end) as m33," & _
"sum(case when SEMAINE = 34 then PT else 0 end) as m34" & _
"sum(case when SEMAINE = 35 then PT else 0 end) as m35," & _
"sum(case when SEMAINE = 36 then PT else 0 end) as m36," & _
"sum(case when SEMAINE = 37 then PT else 0 end) as m37," & _
"sum(case when SEMAINE = 38 then PT else 0 end) as m38," & _
"sum(case when SEMAINE = 39 then PT else 0 end) as m39," & _
"sum(case when SEMAINE = 40 then PT else 0 end) as m40," & _
"sum(case when SEMAINE = 41 then PT else 0 end) as m41," & _
"sum(case when SEMAINE = 42 then PT else 0 end) as m42," & _
"sum(case when SEMAINE = 43 then PT else 0 end) as m43," & _
"sum(case when SEMAINE = 44 then PT else 0 end) as m44," & _
"sum(case when SEMAINE = 45 then PT else 0 end) as m45," & _
"sum(case when SEMAINE = 46 then PT else 0 end) as m46," & _
"sum(case when SEMAINE = 47 then PT else 0 end) as m47," & _
"sum(case when SEMAINE = 48 then PT else 0 end) as m48," & _
"sum(case when SEMAINE = 49 then PT else 0 end) as m49," & _
"sum(case when SEMAINE = 50 then PT else 0 end) as m50," & _
"sum(case when SEMAINE = 51 then PT else 0 end) as m51," & _
"sum(case when SEMAINE = 52 then PT else 0 end) as m52," & _
"sum(case when SEMAINE = 53 then PT else 0 end) as m53" & _
"From [Feuil1$] Group BY LIG_MAITRE",cnn,3,3,&H0001
i = 2
Do While Not rs.EOF
objWb3.Cells(i, 1) = rs("LIGNE_MAIT")
objWb3.Cells(i, 2) = rs("M1")
objWb3.Cells(i, 3) = rs("M2")
objWb3.Cells(i, 4) = rs("M3")
objWb3.Cells(i, 5) = rs("M4")
objWb3.Cells(i, 6) = rs("M5")
objWb3.Cells(i, 7) = rs("M6")
objWb3.Cells(i, 8) = rs("M7")
objWb3.Cells(i, 9) = rs("M8")
objWb3.Cells(i, 10) = rs("M9")
objWb3.Cells(i, 11) = rs("M10")
objWb3.Cells(i, 12) = rs("M11")
objWb3.Cells(i, 13) = rs("M12")
objWb3.Cells(i, 14) = rs("M13")
objWb3.Cells(i, 15) = rs("M14")
objWb3.Cells(i, 16) = rs("M15")
objWb3.Cells(i, 17) = rs("M16")
objWb3.Cells(i, 18) = rs("M17")
objWb3.Cells(i, 19) = rs("M18")
objWb3.Cells(i, 20) = rs("M19")
objWb3.Cells(i, 21) = rs("M20")
objWb3.Cells(i, 22) = rs("M21")
objWb3.Cells(i, 23) = rs("M22")
objWb3.Cells(i, 24) = rs("M23")
objWb3.Cells(i, 25) = rs("M24")
objWb3.Cells(i, 26) = rs("M25")
objWb3.Cells(i, 27) = rs("M26")
objWb3.Cells(i, 28) = rs("M27")
objWb3.Cells(i, 29) = rs("M28")
objWb3.Cells(i, 30) = rs("M29")
objWb3.Cells(i, 31) = rs("M30")
objWb3.Cells(i, 32) = rs("M31")
objWb3.Cells(i, 33) = rs("M32")
objWb3.Cells(i, 34) = rs("M33")
objWb3.Cells(i, 35) = rs("M34")
objWb3.Cells(i, 36) = rs("M35")
objWb3.Cells(i, 37) = rs("M36")
objWb3.Cells(i, 38) = rs("M37")
objWb3.Cells(i, 39) = rs("M38")
objWb3.Cells(i, 40) = rs("M39")
objWb3.Cells(i, 41) = rs("M40")
objWb3.Cells(i, 42) = rs("M41")
objWb3.Cells(i, 43) = rs("M42")
objWb3.Cells(i, 44) = rs("M43")
objWb3.Cells(i, 45) = rs("M44")
objWb3.Cells(i, 46) = rs("M45")
objWb3.Cells(i, 47) = rs("M46")
objWb3.Cells(i, 48) = rs("M47")
objWb3.Cells(i, 49) = rs("M48")
objWb3.Cells(i, 50) = rs("M49")
objWb3.Cells(i, 51) = rs("M50")
objWb3.Cells(i, 52) = rs("M51")
objWb3.Cells(i, 53) = rs("M52")
objWb3.Cells(i, 54) = rs("M53")
rs.MoveNext
i = i + 1
Loop
' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
' *********** FIN *******************'
rs.Close
cnn.Close
Set rs = Nothing
' WScript.Echo "We save now"
' save as now again
'FileName = GetPath + "KPI01.xls"
'objXL.ActiveWorkbook.SaveAs FileName
'WScript.Echo "We are saving now"

objXl.Quit() ' Quit Excel
Set objXL = Nothing
WScript.Quit()

'##########################
Function GetPath
' Retrieve the script path
DIM path
path = WScript.ScriptFullName ' Script name
GetPath = Left(path, InstrRev(path, ""))
End Function

Vous avez filtré cet utilisateur ! Consultez son message

Un petit détail important, si ta version Excel est plus ancienne
qu'excel 2002, quand tu ouvres un classeur par automation
dans une nouvelle instance d'excel, tu dois ajouter par programmation
la référence mentionnée même si elle est présente lorsque tu ouvres
ton classeur normalement. Ce n'est pas le cas pour les versions
excel 2002 et 2003.

Pour vérifier la présence de la référence, tu rends l'application Excel
créé par automation visible et tu vérifies si la référence est bien présente.

"MichDenis" a écrit dans le message de news:

Tu dois ajouter à ton classeur à partir de l'interface
de l'éditeur de code la référence suivante :

"Microsoft Activex Data Object 2.x librairy"

et essaie de déclarer tes objets de cette manière pour la section "Feuil3"

Dim cnn As ADODB.Connection, rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open ... la suite

Set rs = New ADODB.Recordset

"Ralf Meuser" a écrit dans le message de news:
46bc8c4b$0$425$
Salut a tous

J'essai de importer un fichier CSV et de crée une feuille avec un
regroupement de données.

Importations fonctionne maintenant, mais j'ai un problème pour ma requête
SQL.

Merci avance pour tout aide.

Bon week-end

Ralf

----------------------------------------------------
voici mon script
---------------------------------------------------
Option Explicit
Const vbNormal = 1 ' window style

DIM objXL, objWb, objWb2, objWb3, objR, objTab ' Excel object variables
DIM Title, Text, tmp, i, j, file, name, FileName
DIM myString

' here you may set the name of the file to be imported
file = "S:UnifaceKPI01.TXT" ' must be located in the script folder

' create an Excel object reference
Set objXL = WScript.CreateObject ("Excel.Application")

' set the Excel window properties (not absolutely necessary)
objXL.WindowState = vbNormal ' Normal
objXL.Height = 300 ' height
objXL.Width = 400 ' width
objXL.Left = 40 ' X-Position
objXL.Top = 20 ' Y-Position
objXL.Visible = true ' show window

' Create new Workbook (needed for import the CSV file Set objWb = objXl.WorkBooks.Add

' Get the first loaded worksheet object of the current workbook
Set objWb = objXL.ActiveWorkBook.WorkSheets(1)
Set objWb2 = objXL.ActiveWorkBook.WorkSheets(2)
Set objWb3 = objXL.ActiveWorkBook.WorkSheets(3)
objWb.Activate ' not absolutely necessary (for CSV)
' Now invoke the import wizard

'Set objTab = objWb.QueryTables.Add ("TEXT;"+GetPath + file,
objWb.Range("A1"))
Set objTab = objWb.QueryTables.Add ("TEXT;"+file, objWb.Range("A1"))

' here comes the mumbo jumbo to set all the properties for the wizard
' Oh Microsoft, how do I wish to has a With feature or a possibility to
' pass named arguments to methods ....
objTab.Name = "Names"
objTab.FieldNames = True
objTab.RowNumbers = False
objTab.FillAdjacentFormulas = False
objTab.PreserveFormatting = True
objTab.RefreshOnFileOpen = False
objTab.RefreshStyle = 1 'xlInsertDeleteCells
objTab.SavePassword = False
objTab.SaveData = True
objTab.AdjustColumnWidth = True
objTab.RefreshPeriod = 0
objTab.TextFilePromptOnRefresh = False
objTab.TextFilePlatform = 2 'xlWindows
objTab.TextFileStartRow = 1
objTab.TextFileParseType = 1 'xlDelimited
objTab.TextFileTextQualifier = -4142 ' xlTextQualifierNone
objTab.TextFileConsecutiveDelimiter = False
objTab.TextFileTabDelimiter = False ' ### my delimiters
objTab.TextFileSemicolonDelimiter = True
objTab.TextFileCommaDelimiter = False
objTab.TextFileSpaceDelimiter = False
objTab.TextFileColumnDataTypes Array(1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
objTab.Refresh False

'WScript.Echo "We have loaded the worksheet"

' demonstrate how to read the column header values
Text = "Worksheet " + objWb.name + vbCRLF
Text = Text + "Column titles" + vbCRLF
Text = Text + CStr(objWb.Cells(1, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(1, 2).Value) + vbCRLF

' show some cell values (using the "hard coded method")
Text = Text + CStr(objWb.Cells(2, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(2, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(3, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(3, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(4, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(4, 2).Value) + vbCRLF

'' Show results
'MsgBox Text, vbOkOnly+ vbInformation, Title
'objXL.ActiveSheet.PrintOut ' print Worksheet
'WScript.Echo "We are printing, close after printing"

' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
'WScript.Echo "We are saving now"

'*****Feuil3 ******"
Dim cnn,rs,sql
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data
Source=C:utiKPIKPI01.xls; Extended Properties=""Excel 8.0;HDR=Yes;"";"
rs.Open "SELECT LIG_MAITRE," & _
"sum(case when SEMAINE = 1 then PT else 0 end) as m1," & _
"sum(case when SEMAINE = 2 then PT else 0 end) as m2," & _
"sum(case when SEMAINE = 3 then PT else 0 end) as m3," & _
"sum(case when SEMAINE = 4 then PT else 0 end) as m4," & _
"sum(case when SEMAINE = 5 then PT else 0 end) as m5," & _
"sum(case when SEMAINE = 6 then PT else 0 end) as m6," & _
"sum(case when SEMAINE = 7 then PT else 0 end) as m7," & _
"sum(case when SEMAINE = 8 then PT else 0 end) as m8," & _
"sum(case when SEMAINE = 9 then PT else 0 end) as m9," & _
"sum(case when SEMAINE = 10 then PT else 0 end) as m10," & _
"sum(case when SEMAINE = 11 then PT else 0 end) as m11," & _
"sum(case when SEMAINE = 12 then PT else 0 end) as m12," & _
"sum(case when SEMAINE = 13 then PT else 0 end) as m13," & _
"sum(case when SEMAINE = 14 then PT else 0 end) as m14," & _
"sum(case when SEMAINE = 15 then PT else 0 end) as m15," & _
"sum(case when SEMAINE = 16 then PT else 0 end) as m16," & _
"sum(case when SEMAINE = 17 then PT else 0 end) as m17," & _
"sum(case when SEMAINE = 18 then PT else 0 end) as m18," & _
"sum(case when SEMAINE = 19 then PT else 0 end) as m19," & _
"sum(case when SEMAINE = 20 then PT else 0 end) as m20," & _
"sum(case when SEMAINE = 21 then PT else 0 end) as m21," & _
"sum(case when SEMAINE = 22 then PT else 0 end) as m22," & _
"sum(case when SEMAINE = 23 then PT else 0 end) as m23," & _
"sum(case when SEMAINE = 24 then PT else 0 end) as m24," & _
"sum(case when SEMAINE = 25 then PT else 0 end) as m25," & _
"sum(case when SEMAINE = 26 then PT else 0 end) as m26," & _
"sum(case when SEMAINE = 27 then PT else 0 end) as m27," & _
"sum(case when SEMAINE = 28 then PT else 0 end) as m28," & _
"sum(case when SEMAINE = 29 then PT else 0 end) as m29," & _
"sum(case when SEMAINE = 30 then PT else 0 end) as m30," & _
"sum(case when SEMAINE = 31 then PT else 0 end) as m31," & _
"sum(case when SEMAINE = 32 then PT else 0 end) as m32," & _
"sum(case when SEMAINE = 33 then PT else 0 end) as m33," & _
"sum(case when SEMAINE = 34 then PT else 0 end) as m34" & _
"sum(case when SEMAINE = 35 then PT else 0 end) as m35," & _
"sum(case when SEMAINE = 36 then PT else 0 end) as m36," & _
"sum(case when SEMAINE = 37 then PT else 0 end) as m37," & _
"sum(case when SEMAINE = 38 then PT else 0 end) as m38," & _
"sum(case when SEMAINE = 39 then PT else 0 end) as m39," & _
"sum(case when SEMAINE = 40 then PT else 0 end) as m40," & _
"sum(case when SEMAINE = 41 then PT else 0 end) as m41," & _
"sum(case when SEMAINE = 42 then PT else 0 end) as m42," & _
"sum(case when SEMAINE = 43 then PT else 0 end) as m43," & _
"sum(case when SEMAINE = 44 then PT else 0 end) as m44," & _
"sum(case when SEMAINE = 45 then PT else 0 end) as m45," & _
"sum(case when SEMAINE = 46 then PT else 0 end) as m46," & _
"sum(case when SEMAINE = 47 then PT else 0 end) as m47," & _
"sum(case when SEMAINE = 48 then PT else 0 end) as m48," & _
"sum(case when SEMAINE = 49 then PT else 0 end) as m49," & _
"sum(case when SEMAINE = 50 then PT else 0 end) as m50," & _
"sum(case when SEMAINE = 51 then PT else 0 end) as m51," & _
"sum(case when SEMAINE = 52 then PT else 0 end) as m52," & _
"sum(case when SEMAINE = 53 then PT else 0 end) as m53" & _
"From [Feuil1$] Group BY LIG_MAITRE",cnn,3,3,&H0001
i = 2
Do While Not rs.EOF
objWb3.Cells(i, 1) = rs("LIGNE_MAIT")
objWb3.Cells(i, 2) = rs("M1")
objWb3.Cells(i, 3) = rs("M2")
objWb3.Cells(i, 4) = rs("M3")
objWb3.Cells(i, 5) = rs("M4")
objWb3.Cells(i, 6) = rs("M5")
objWb3.Cells(i, 7) = rs("M6")
objWb3.Cells(i, 8) = rs("M7")
objWb3.Cells(i, 9) = rs("M8")
objWb3.Cells(i, 10) = rs("M9")
objWb3.Cells(i, 11) = rs("M10")
objWb3.Cells(i, 12) = rs("M11")
objWb3.Cells(i, 13) = rs("M12")
objWb3.Cells(i, 14) = rs("M13")
objWb3.Cells(i, 15) = rs("M14")
objWb3.Cells(i, 16) = rs("M15")
objWb3.Cells(i, 17) = rs("M16")
objWb3.Cells(i, 18) = rs("M17")
objWb3.Cells(i, 19) = rs("M18")
objWb3.Cells(i, 20) = rs("M19")
objWb3.Cells(i, 21) = rs("M20")
objWb3.Cells(i, 22) = rs("M21")
objWb3.Cells(i, 23) = rs("M22")
objWb3.Cells(i, 24) = rs("M23")
objWb3.Cells(i, 25) = rs("M24")
objWb3.Cells(i, 26) = rs("M25")
objWb3.Cells(i, 27) = rs("M26")
objWb3.Cells(i, 28) = rs("M27")
objWb3.Cells(i, 29) = rs("M28")
objWb3.Cells(i, 30) = rs("M29")
objWb3.Cells(i, 31) = rs("M30")
objWb3.Cells(i, 32) = rs("M31")
objWb3.Cells(i, 33) = rs("M32")
objWb3.Cells(i, 34) = rs("M33")
objWb3.Cells(i, 35) = rs("M34")
objWb3.Cells(i, 36) = rs("M35")
objWb3.Cells(i, 37) = rs("M36")
objWb3.Cells(i, 38) = rs("M37")
objWb3.Cells(i, 39) = rs("M38")
objWb3.Cells(i, 40) = rs("M39")
objWb3.Cells(i, 41) = rs("M40")
objWb3.Cells(i, 42) = rs("M41")
objWb3.Cells(i, 43) = rs("M42")
objWb3.Cells(i, 44) = rs("M43")
objWb3.Cells(i, 45) = rs("M44")
objWb3.Cells(i, 46) = rs("M45")
objWb3.Cells(i, 47) = rs("M46")
objWb3.Cells(i, 48) = rs("M47")
objWb3.Cells(i, 49) = rs("M48")
objWb3.Cells(i, 50) = rs("M49")
objWb3.Cells(i, 51) = rs("M50")
objWb3.Cells(i, 52) = rs("M51")
objWb3.Cells(i, 53) = rs("M52")
objWb3.Cells(i, 54) = rs("M53")
rs.MoveNext
i = i + 1
Loop
' save as now
FileName = GetPath + "KPI01.xls"
objXL.DisplayAlerts = False ' prevent all message boxes
objXL.ActiveWorkbook.SaveAs FileName
objXL.DisplayAlerts = True ' prevent all message boxes
' *********** FIN *******************'
rs.Close
cnn.Close
Set rs = Nothing
' WScript.Echo "We save now"
' save as now again
'FileName = GetPath + "KPI01.xls"
'objXL.ActiveWorkbook.SaveAs FileName
'WScript.Echo "We are saving now"

objXl.Quit() ' Quit Excel
Set objXL = Nothing
WScript.Quit()

'##########################
Function GetPath
' Retrieve the script path
DIM path
path = WScript.ScriptFullName ' Script name
GetPath = Left(path, InstrRev(path, ""))
End Function

Probleme de SQL

3 réponses

Veuillez sélectionner un problème