Convertir un CSV en XLS

lebarbo

XLDnaute Occasionnel
Bonjour à tous,

J'ai un code qui me permet d'enregistrer une pièce jointe quand un mail arrive dans ma boite aux lettres, mon souci c'est que la pièce jointe est en CSV et je n'arrive pas à convertir proprement le CSV en XLS pour ensuite pouvoir modifier certaines cellules en VBA.
Voici mon code :

Private Sub objInbox_ItemAdd(ByVal Item As Object)

If Item.Class = OLmail And InStr(1, Item.Subject, "Repères") > 0 Then
If Item.Attachments.Count > 0 Then
Dim objAttachments As Outlook.Attachments
Set objAttachments = Item.Attachments
For Each objAttach In objAttachments
' Does not handle duplicate filename scenarios
objAttach.SaveAsFile "C:\Mon dossier\essai.xls" '& objAttach.FileName
Next
Set objAttachments = Nothing
Call modif
End If
End If

End Sub

Donc j'enregistre ma pièce en xls, du coup les cellules sont toutes en colonne A au lieu d'être proprement réparti en fonction du point virgule. Si jamais j'essaie en code de réouvrir ce XLS et de convertir les colonnes :

''Ouverture de l'application
Set appExcel = CreateObject("Excel.Application")
''Ouverture d'un fichier Excel
Set wbExcel = appExcel.Workbooks.Open("C:\Mon dossier\essai.xls")
''wsExcel correspond à la première feuille du fichier
Set wsExcel = wbExcel.Worksheets(1)

'wsExcel.Columns("A:A").TextToColumns Destination:=wsExcel.Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array( _
59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65, 1), _
Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1), Array( _
72, 1), Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1)), _
TrailingMinusNumbers:=True


Il ne se passe visiblement pas grand chose. Je tourne en rond sans comprendre.
Merci de votre aide,
 

lebarbo

XLDnaute Occasionnel
Re : Convertir un CSV en XLS

Bonjour à tous,

Me revoilà, et oui j'ai encore un problème :( mais j'ai confiance dans votre efficacité à le solutionner :)
Alors sur ma première colonne j'ai des dates. Quand j'ouvre le fichier d'origine donc celui en pièce jointe du mail, les dates apparaissent en format France JJ/MM/AAAA correctement mais lorsque j'ouvre le fichier après transformation c'est à dire après la sauvegarde
wbExcel.SaveAs "C:\Mon dossier\essai4.csv", FileFormat:=xlCSV, CreateBackup:=False, local:=True
le format est changé en MM/JJ/AAAA.
Y aurait-il une fonction de sauvegarde pour enregistrer au bon format ? comme LocalData:=True par exemple ?

Merci d'avance,

PS : Papou, une chance de rebondir :)
 

lebarbo

XLDnaute Occasionnel
Re : Convertir un CSV en XLS

Bonjour à tous,

Après de multiples recherches me voici de retour.

Dans le ThisOutlook j'ai :
---------------------------------------------
Dim WithEvents objInbox As Outlook.Items
Private Sub Application_Startup()
Set objInbox = Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub objInbox_ItemAdd(ByVal Item As Object)
Const xlNormal = -4143

If Item.Class = OLmail And InStr(1, Item.Subject, "Repères") > 0 Then
If Item.Attachments.Count > 0 Then
Dim objAttachments As Outlook.Attachments
Set objAttachments = Item.Attachments
For Each objAttach In objAttachments
' Does not handle duplicate filename scenarios
objAttach.SaveAsFile "C:\Mon dossier\essai.csv" '& objAttach.FileName

Next
Set objAttachments = Nothing
Call modif
End If
End If

End Sub
------------------------------------

Dans mon module :
----------------------------------
Sub modif()
Dim appExcel
Dim wbExcel
Dim wsExcel

Const xlDown = -4121
Const xlDelimited = 1

'Ouverture de l'application
Set appExcel = CreateObject("Excel.Application")
''Ouverture d'un fichier Excel
Set wbExcel = appExcel.Workbooks.Open("C:\Mon dossier\essai.csv")
'wsExcel correspond à la première feuille du fichier
Set wsExcel = wbExcel.Worksheets(1)

appExcel.DisplayAlerts = False
wsExcel.Columns(1).TextToColumns Destination:=wsExcel.Range("A1"), DataType:=xlDelimited, Tab:=False, Semicolon:=True
appExcel.DisplayAlerts = True

'Code pour modifier le fichier

DerLigne = wsExcel.Range("A1").End(xlDown).Row

For i = 2 To DerLigne

If wsExcel.Cells(i, 2).Value = "55" Then
wsExcel.Cells(i, 6).Value = wsExcel.Cells(i, 6).Value & "Oui"
End If

Next i

appExcel.DisplayAlerts = False
wbExcel.SaveAs "C:\Mon dossier\essai.csv", FileFormat:=xlCSV, CreateBackup:=False, Local:=True
appExcel.DisplayAlerts = True


wbExcel.Close False 'Fermeture du classeur Excel
appExcel.Quit 'Fermeture de l'application Excel
'Désallocation mémoire
Set wsExcel = Nothing
Set wbExcel = Nothing
Set appExcel = Nothing

End Sub
---------------------------
A mon avis je peux remplacer cette ligne :
wsExcel.Columns(1).TextToColumns Destination:=wsExcel.Range("A1"), DataType:=xlDelimited, Tab:=False, Semicolon:=True
Par la méthode OpenText avec la variable Local=True pour pour solutionner mon problème de date à l'anglaise comme cf. sur le site de Microsoft
Format de date n'est pas correct lorsque vous convertissez un fichier texte CSV dans Excel à l'aide d'une macro VBA

Malheureusement, je n'arrive pas à adapter le code, j'ai essayé sans succès.

Merci d'avance,
 
Dernière édition:

lebarbo

XLDnaute Occasionnel
Re : Convertir un CSV en XLS

Bonjour à tous,

Après de longues heures de recherche, j'ai trouvé la solution, il suffisait d'ajouter :
FieldInfo:=Array(0, xlDMYFormat)
à la ligne :
wsExcel.Columns(1).TextToColumns Destination:=wsExcel.Range("A1"), DataType:=xlDelimited, Tab:=False, Semicolon:=True

Il suffisait juste de le savoir ; )
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA