Import ADODB - Conversion étrange

etbahoui

XLDnaute Nouveau
Bonjour,

je fais un import classique d'un txt via ADODB.
Cependant, une colonne se retrouve au format Heure à l'arrivée.
En entrée, j'ai (avec un espace devant ou sans, ça ne change rien) :
6,00;
2,50;
4,00;
5,25;
5,25;
4,50;
A l'arrivée, j'ai :
0,250694444
0,118055556
0,167361111
0,225694444
0,225694444
0,201388889

En jouant avec le format de la cellule cible et/ou du Rs.Fields importé, j'obtient la valeur au format Heure (étrange...)
06:01:00
02:50:00
04:01:00
05:25:00
05:25:00
04:50:00
Idem si je fais un replace de la virgule par un point...
J'ai d'autres colonnes de ce type, et pourtant il fait bien la conversion tout seul cette fois....

Please Help.
 

etbahoui

XLDnaute Nouveau
Re : Import ADODB - Conversion étrange

c'est une macro classique ADODB, sauf que je lis ligne par ligne, pour pouvoir faire des stats à la volée. ça ne change rien en utilisant un CopyFromRecordSet global.
Si je fais une importation de base manuelle en ouvrant le fichier texte, ça marche tout seul, mais bon, ce n'est pas le but. J'ai tenté de rajouter Replace(Rs.Fields(0), ",", "."), en vain.

Set FSO = CreateObject("Scripting.FileSystemObject")
sCheminFichier = FSO.GetFile(Fichier).ParentFolder.Path
sNomFichier = FSO.GetFile(Fichier).Name
Set FSO = Nothing

Set Conn = CreateObject("ADODB.CONNECTION")
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sCheminFichier & ";" & _
"Extended Properties=""text;" & _
"HDR=No;" & _
"FMT=Delimited;MaxScanRows=0"""

Set Rs = CreateObject("AdoDb.Recordset")
SQL = "SELECT * FROM " & sNomFichier
Rs.Open SQL, Conn, 3, 1, 1


Sheets.Add
Range("A:Z").Select
Range("A:Z").NumberFormat = "@"

ActiveSheet.Name = "Part1"
'Lecture séquentielle du curseur
While Not (Rs.EOF)

ActiveSheet.Cells(ligne, 1) = Rs.Fields(0)

Rs.MoveNext
ligne = ligne + 1
If ligne = 30000 Then
ligne = 1
page = page + 1
Sheets.Add
ActiveSheet.Name = "Part" & page
End If
Wend

Rs.Close
Set Rs = Nothing

Conn.Close
Set Conn = Nothing
End Sub
 

etbahoui

XLDnaute Nouveau
Re : Import ADODB - Conversion étrange

En entrée, dans le fichier texte et la colonne concernée, ce sont des taux : 4,50 par exemple. Je veux que dans la cellule cible apparaisse un taux : 4,50 ou au pire du texte.
Or, il me la convertit tout seul en 06:00:00 alors que je ne lui ai rien demandé, ce qui, au format décimal fait 0,201388889...
Dans la colonne suivante du fichier texte, j'ai aussi un taux, et là il me le retourne correctement...de quoi s'arracher les cheveux.
Excel 2003 pour info
 

wilfried_42

XLDnaute Barbatruc
Re : Import ADODB - Conversion étrange

re:

je croyais que tu voulais des heures desolé
à essayer
Code:
ActiveSheet.Cells(ligne, 1) = cdbl(Rs.Fields(0))
si ce n'est pas çà, il va falloir que tu postes des exemples (fichier import et fichier reception avec la macro)
 

etbahoui

XLDnaute Nouveau
Re : Import ADODB - Conversion étrange

Voici la macro complète :

Option Explicit
Dim sCheminFichier As String
Dim sNomFichier As String

Sub PEL()
Dim Fichier As Variant
Dim FichierSave As Variant
Dim Conn As Object
Dim Rs As Object
Dim FSO As Object
Dim Debut As Variant
Dim SQL As String
Dim ligne As Long
Dim suiviligne As Long
Dim lignepart1 As Long
Dim lignepart2 As Long
Dim page As Long
Dim totalpel As Long


Fichier = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "Sélectionnez un fichier Stock PEL au format TXT... (le nom ne doit pas contenir d'espaces)")
If Fichier = False Then Exit Sub

Application.StatusBar = ""
Debut = DateTime.TIME()
Application.ScreenUpdating = False


Set FSO = CreateObject("Scripting.FileSystemObject")
sCheminFichier = FSO.GetFile(Fichier).ParentFolder.Path
sNomFichier = FSO.GetFile(Fichier).Name
Set FSO = Nothing

Set Conn = CreateObject("ADODB.CONNECTION")
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sCheminFichier & ";" & _
"Extended Properties=""text;" & _
"HDR=No;" & _
"FMT=Delimited;MaxScanRows=0"""

'Requête de lecture du fichier
Set Rs = CreateObject("AdoDb.Recordset")
SQL = "SELECT * FROM " & sNomFichier
Rs.Open SQL, Conn, 3, 1, 1
Application.StatusBar = "Lecture du fichier stock " & sNomFichier & " en cours - veuillez patienter"

ligne = 1
suiviligne = 1
page = 1

totalpel = 0

Sheets.Add
ActiveSheet.Name = "Part1"
Range("A:Z").Select
Range("A:Z").NumberFormat = "@"


'Lecture séquentielle du curseur
While Not (Rs.EOF)

ActiveSheet.Cells(ligne, 1) = CStr(Rs.Fields(0))
ActiveSheet.Cells(ligne, 2) = CStr(Rs.Fields(1))
ActiveSheet.Cells(ligne, 3) = CStr(Rs.Fields(2))
ActiveSheet.Cells(ligne, 4) = CStr(Rs.Fields(3))

ActiveSheet.Cells(ligne, 5) = CDbl(Rs.Fields(4))

ActiveSheet.Cells(ligne, 6) = CDbl(Rs.Fields(5))
ActiveSheet.Cells(ligne, 7) = CStr(Rs.Fields(6))
ActiveSheet.Cells(ligne, 8) = CStr(Rs.Fields(7))
ActiveSheet.Cells(ligne, 9) = CStr(Rs.Fields(8))
ActiveSheet.Cells(ligne, 10) = CStr(Rs.Fields(9))
ActiveSheet.Cells(ligne, 11) = CStr(Rs.Fields(10))
ActiveSheet.Cells(ligne, 12) = CStr(Rs.Fields(11))
ActiveSheet.Cells(ligne, 13) = Rs.Fields(12)
ActiveSheet.Cells(ligne, 14) = Rs.Fields(13)
ActiveSheet.Cells(ligne, 15) = Rs.Fields(14)
ActiveSheet.Cells(ligne, 16) = CStr(Rs.Fields(15))
ActiveSheet.Cells(ligne, 17) = CStr(Rs.Fields(16))
ActiveSheet.Cells(ligne, 18) = Rs.Fields(17)



totalpel = totalpel + 1

Rs.MoveNext
ligne = ligne + 1
If page = 1 Then
lignepart1 = ligne
Else
lignepart2 = ligne
End If
'Nouvelle feuille toutes les 65000 lignes
suiviligne = suiviligne + 1
If suiviligne = 10000 Then
suiviligne = 0
Application.StatusBar = "Lecture du fichier stock " & sNomFichier & " en cours - veuillez patienter - page " & page & " - ligne " & ligne
End If
If ligne = 65000 Then
ligne = 1
page = page + 1
Sheets.Add
ActiveSheet.Name = "Part" & page
Application.StatusBar = "Lecture du fichier stock " & sNomFichier & " en cours - veuillez patienter - page " & page '

End If
Wend


Rs.Close
Set Rs = Nothing

Conn.Close
Set Conn = Nothing
Application.StatusBar = "Mise en forme en cours - veuillez patienter..."

'Mise en forme des deux premières feuilles
Sheets("Macro").Select
Rows("1:1").Select
Selection.Copy
Sheets("Part1").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Cells.EntireColumn.AutoFit

If page > 1 Then
Sheets("Macro").Select
Rows("1:1").Select
Selection.Copy
Sheets("Part2").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Cells.EntireColumn.AutoFit

End If

Application.StatusBar = "Calcul Statistiques en cours"

'Stats globaux
Sheets("Stats").Select
Sheets("Stats").Range("C3") = totalpel



Application.StatusBar = "Statistiques OK : " & Strings.Format((DateTime.TIME() - Debut) * 100000, "0.00") & " secondes"

Application.ScreenUpdating = True
Application.DisplayAlerts = False
Sheets("Macro").Select
'ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
'Sheets("Stats").Select
Sheets("Part1").Select
'FichierSave = Application.GetSaveAsFilename("Stats-PEL-200903nn.xls", , , "Veuillez sauvergarder le classeur...")
'If FichierSave <> False Then
' ActiveWorkbook.SaveAs FichierSave
'End If
End Sub

et le fichier txt version réduite :
10228;2298;100428;439; 6,00; 4,62;19940121;04;06;00000000;20021209;20040121; 228,67; 0,00; ; 42 035,69; 6 097,96; 24 507,46;
10228;2298;101750;439; 2,50; 2,50;20050901;04;00;00000000;00000000;20090901; 225,00; 50,00;MENSUELLE ; 2 325,00; 103,75; 0,00;
10228;2298;102854;439; 4,00; 2,90;19981201;04;06;00000000;20071019;20081201; 228,67; 0,00; ; 5 883,19; 1 399,60; 15,69;
10228;2298;103001;439; 5,25; 3,84;19970114;04;06;00000000;20060106;20070114; 1 524,49; 0,00; ; 23 969,50; 5 335,71; 4 308,92;
10228;2298;103028;439; 5,25; 3,84;19970114;04;06;00000000;20060106;20070114; 304,90; 0,00; ; 5 634,02; 1 896,45; 544,54;
10228;2298;103087;439; 4,50; 3,27;20020909;04;06;00000000;20060620;20120909; 225,00; 100,00;MENSUELLE ; 24 935,00; 4 231,32; 0,00;
 

Statistiques des forums

Discussions
312 386
Messages
2 087 854
Membres
103 669
dernier inscrit
Anne Sicard