transfert mysql -> excel

**boss_gama** · 29/06/2006, 11h21

Salut,
Je cherche à exporter certaines données d'une table mysql vers un fichier excel. Pour cela, j'utilise un modèle, et quand je trouve un champ sous excel je le remplace par la valeur correspondante tirée de la base mysql.
Pour ne pas modifier le modèle, je créé un fichier temporaire
Cependant j'ai une erreur 800a0bb9:
'Les arguments sont de type incorrect, en dehors des limites autorisées ou en conflit les uns avec les autres.'
est-ce que quelqu'un peut m'éclairer?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
<%
	name =  "commande_MODELE" & ".xls"
	path = "C:\Documents and Settings\boss_gama\Mes documents\excel\"
	docname = replace(date,"/","") & replace(Time,":","") & ".xls"
 
	Set fs = Server.CreateObject("Scripting.FileSystemObject")
	file = path & name
	fs.CopyFile path & "\tmp\" & docname, file
	file = path & "\tmp\" & docname
 
	'--- Modifier le fichier excel
	Set oConn = Server.CreateObject("ADODB.Connection")
	oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
	               "Data Source=" & file & _
	               ";Extended Properties=""Excel 8.0;HDR=YES;"""
 
	strSheet= "Feuil1"
 
	Set oRS = Server.CreateObject("ADODB.Recordset")
	oRS.Open "SELECT * FROM " & strSheet, oConn, adOpenKeyset, adLockOptimistic
 
	'Nous récupérons les données contenues dans  la table  mysql
	sql = "SELECT " & request.form("Champ") & " FROM " & request.form("Table") & " WHERE " & request.form("id") & " = " & request.form("num")
	response.write sql
	rst.open SQL ,conn
 
	Do Until oRS.EOF
		if not rst.eof then
			For i = 0 To rst.Fields.Count - 1  ' on parcours tous les champs
				Cells.Replace What = rst.Fields(i), Replacement = rst.Fields(i).value, LookAt = xlPart, _
				SearchOrder = xlByRows, MatchCase = False, SearchFormat = False, _
				ReplaceFormat = False
			next
		end if
	loop
	oRS.close
	oConn.Close
 
	fs.CopyFile path & "\templates\" & docname & ".xls", file
	fs.DeleteFile file
 
	Set oConn = Nothing
 
 
%>

Et aussi, est-ce que quelqu'un pourrait me dire comment trouver le nom de feuille de manière automatique, car si ce n'est pas feuil1 ca plante.

**amar00** · 29/06/2006, 12h00

est-ce que quelqu'un pourrait me dire comment trouver le nom de feuille de manière automatique

2 manières à ma connaissance de trouver le nom de la première feuille

ADO

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
Dim Conn : Set Conn = Server.CreateObject("ADODB.Connection")
strConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="_
		                      & pParametres _
		                      & ";Extended Properties=""Excel 8.0;HDR=Yes:IMEX=1"""  
Conn.ConnectionString = strConnectionString
Conn.open
dim rsListeTables : set rsListeTables = Conn.OpenSchema(adSchemaTables)
dim nomFeuille : nomFeuille = rsListeTables("TABLE_NAME")

COM

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
Dim oComExcel : set oComExcel = server.createObject("Excel.Application")
oComExcel.WorkBooks.open "chemin physique du fichier excel"
Dim monClasseur : set monClasseur = oComExcel.ActiveWorkBook
Dim nomFeuille : set nomFeuille = monClasseur.Sheets(1).name

**boss_gama** · 29/06/2006, 12h12

La méthode openschema plante toujours chez moi. toujours cette fichue erreur:
'Le fournisseur ou l'objet ne prend pas en charge cette opération.'

Par contre la 2e méthode marche.

Je continue à déboguer...

**boss_gama** · 29/06/2006, 14h35

Bon j'ai codé un script qui ne marche pas

.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
	name =  "commande_MODELE" & ".xls"
	path = "C:\Gestion\IOL\"
	docname = replace(date,"/","") & replace(Time,":","") & ".xls"
 
	Set fs = Server.CreateObject("Scripting.FileSystemObject")
	file = path & name
	fs.CopyFile file,path & "\tmp\" & docname
	file = path & "\tmp\" & docname
 
	Set Eapp = SERVER.CreateObject("Excel.Application")
	Eapp.WorkBooks.open file
 
	'Nous récupérons les données contenues dans  la table  mysql
	sql = "SELECT " & request.form("Champ") & " FROM " & request.form("Table") & " WHERE " & request.form("id") & " = " & request.form("num")
	response.write sql
	rst.open SQL ,conn
 
	if not rst.eof then
		For i = 0 To rst.Fields.Count - 1  ' on parcours tous les champs
			Eapp.Range("A1").Select
 
			Eapp.Cells.Replace What = rst.Fields(i).name, Replacement = rst.Fields(i).value, LookAt = xlPart, _
				        SearchOrder = xlByRows, MatchCase = False, SearchFormat = False, _
				        ReplaceFormat = False
		next
	end if
 
	fs.CopyFile path & "\templates\" & docname & ".xls", file
	fs.DeleteFile file

J'ai le droit à une erreur 800a0009 au niveau de laligne replace:
'Indice en dehors de la plage '
Je n'ai aucune idée de pourquoi ca fait ca.
Est-ce que quelqu'un peut me donner un coup de main car la je bloque...

Je pourrais aussi mettre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Eapp.Cells.Find(What = rst.Fields(i).name, After = ActiveCell, LookIn = xlFormulas, LookAt _
			         = xlPart, SearchOrder = xlByRows, SearchDirection = xlNext, MatchCase = _
			        False, SearchFormat = False).Activate
 
			Eapp.ActiveCell.FormulaR1C1 = rst.Fields(i).value
			With Eapp.ActiveCell.Font
		        .Name = "Arial"
		        .FontStyle = "Gras"
		        .Size = 10
		        .Strikethrough = False
		        .Superscript = False
		        .Subscript = False
		        .OutlineFont = False
		        .Shadow = False
		        .Underline = xlUnderlineStyleNone
		        .ColorIndex = 1
		    End With

a la place de :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Eapp.Cells.Replace What = rst.Fields(i).name, Replacement = rst.Fields(i).value, LookAt = xlPart, _
				        SearchOrder = xlByRows, MatchCase = False, SearchFormat = False, _
				        ReplaceFormat = False

mais j'ai à ce moment une erreur de type incompatible sur la line find

**boss_gama** · 29/06/2006, 17h25

Bon, voila ma version de mon script qui tourne le mieux pour l'instant. Enfin tourne....
J'ai un problème sur un composant owc10. Il n'arrive pas à créer l'objet Spreadsheet. Avant que j'installe owc10, le script tournait, mais comme il ne trouvait pas les cellules via usedrange il ne modifiait pas le fichier excel. J'ai installé owc10, et maintenant j'ai une erreur :
'Le CreateObject de '(null)' a provoqué une exception C0000005.'
est-ce que quelqu'un pourrait m'indiquer l'origine du problème, je n'ai nrien trouvé sur le net.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
name =  "commande_MODELE" & ".xls"
	path = "C:\Gestion\IOL\"
	docname = replace(date,"/","") & replace(Time,":","") & ".xls"
 
	Set fs = Server.CreateObject("Scripting.FileSystemObject")
	file = path & name
	fs.CopyFile file,path & "\tmp\" & docname
	file = path & "\tmp\" & docname
 
	Set Eapp = SERVER.CreateObject("Excel.Application")
	set Edoc1 = Eapp.WorkBooks.open(file, , True)
 
	'Nous récupérons les données contenues dans  la table  mysql
	sql = "SELECT " & request.form("Champ") & " FROM " & request.form("Table") & " WHERE " & request.form("id") & " = " & request.form("num")
	response.write sql
	rst.open SQL ,conn
 
	Set oSS = Server.CreateObject("OWC10.Spreadsheet")
	Set Sheet = oSS.Worksheets(1)
	selection = Sheet.UsedRange
 
	response.write selection & "|<br>"
	if not rst.eof then
		For i = 0 To rst.Fields.Count - 1  ' on parcours tous les champs
			response.write rst.Fields(i).name & "1<br>"
			for j = 1 to selection
				response.write Eapp.ActiveCell.FormulaR1C1 & "&&<br>"
				if Eapp.ActiveCell.FormulaR1C1 = rst.Fields(i).name then
					Eapp.ActiveCell.FormulaR1C1 = rst.Fields(i).value
					response.write rst.Fields(i).name & "<br>"
					With Eapp.ActiveCell.Font
				        .Name = "Arial"
				        .FontStyle = "Gras"
				        .Size = 10
				        .Strikethrough = False
				        .Superscript = False
				        .Subscript = False
				        .OutlineFont = False
				        .Shadow = False
				        .Underline = xlUnderlineStyleNone
				        .ColorIndex = 1
				    End With
				end if
			next
		next
	end if
 
	Edoc1.SaveAs "c:\gestion\IOL\tmp\" & docname & ".xls"
	fs.CopyFile file, path & "\templates\" & docname
	fs.DeleteFile file

**Immobilis** · 29/06/2006, 23h07

Tant que tu ne manipules pas de fichier (recherche, copie, effacerment, etc) tu n'as pas besoin du FileSystemObject.
Tu n'as pas non plus besoin de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set Eapp = SERVER.CreateObject("Excel.Application")

Pour créer un fichier Excel. De plus, la création de cet objet sous-entend qu'Excel est installé sur le serveur.
Donc OWC10 suffit. Voici un exemple de code qui créé un fichier Excel à partir d'un recordset.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 
set rs = server.CreateObject("adodb.recordset")
	rs.CursorLocation = 3
	rs.CursorType = 0
	rs.LockType = 1
	rs.open "LA REQUETE SQL", strProvider,1,1
 
Set objSpreadsheet = Server.CreateObject("OWC10.Spreadsheet")
	With objSpreadsheet
		for i= 0 to rs.fields.count - 1
			.Cells(1, i+1).Value = rs.fields(i).name
			.Cells(1, i+1).Interior.Color = "#800000"
			.Cells(1, i+1).Font.Color = "White"
			.Cells(1, i+1).Borders.Color = "Black"
		next
		j = 2
		while not rs.eof 
			for i= 0 to rs.fields.count-1 
				.Cells(j, i+1).Value = rs.fields(i).value
				.Cells(j, i+1).Borders.Color = "Black"
			next
			j = j + 1
			rs.movenext 
		wend
 
		.Rows(1).Autofilter
		FOR i = 1 to rs.fields.count
			.Columns(i).EntireColumn.AutoFit
		NEXT
		.ActiveSheet.Name = xlsname
		.Export server.MapPath("LENOMDUFICHIER.xls"), 0
	End with
Set objSpreadsheet = Nothing
 
rs.close
Set rs = nothing

A+

**boss_gama** · 30/06/2006, 12h03

Bon finalement j'ai trouvé une solution sans passer par le composant owc10 avec lequel je n'arrivais pas à remplacer des valeurs. C'est tout bete mais qu'est-ce que j'aurais pu galérer.

Pour ceux que ca interesse voici ma solution qui modifie un fichier excel en fonction des données d'une base, puis qui l'ouvre:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
<%
	name =  "commande_MODELE" & ".xls"
	path = "C:\Gestion\IOL\"
	docname = replace(date,"/","") & replace(Time,":","") & ".xls"
 
	Set fs = Server.CreateObject("Scripting.FileSystemObject")
	file = path & name
	fs.CopyFile file,path & "\tmp\" & docname
	file = path & "\tmp\" & docname
 
	'Nous récupérons les données contenues dans  la table  mysql
	sql = "SELECT " & request.form("Champ") & " FROM " & request.form("Table") & " WHERE " & request.form("id") & " = " & request.form("num")
	response.write sql
	rst.open SQL ,conn
 
	Set objExcel = Server.CreateObject("Excel.Application")
	Set EDoc1 = objExcel.Workbooks.Open(file, , True)
	Set sheet = EDoc1.Worksheets(1)
 
	Set objRange = sheet.UsedRange 
	for i = 0 to rst.Fields.count -1
		For Each objCell in objRange
			if objCell.Value = rst.Fields(i).name then
 
				if rst.Fields(i).value <> "" then
					objCell.Value = rst.Fields(i).value
				else
					objCell.Value = ""
				end if
 
			end if
		Next
	next
 
	EDoc1.SaveAs path & "templates\" & docname
	EDoc1.close
	objExcel.quit
	path = path & "templates\" & docname
%>
<HTML><BODY>
<script Language=Vbscript>
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~Cration de l'application Excel~~~~~~~~~~~~~~~~~	
Set excel = CreateObject("Excel.Application")
 
	excel.visible=true
 
	'excel.workbooks.Add
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	'~~~~~~~~~~~~~~~~~~Ouverture de l'application Excel~~~~~~~~~~~~~~~~~	
				excel.Workbooks.Open "<%=path%>
				excel.ActiveWindow.WindowState = 2
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	set excel=nothing 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
</script>
 
</BODY>
</HTML>

Merci à tous pour votre aide

transfert mysql -> excel

ASP

Discussions similaires

Partager

Partager