macro vba import fichier bancaire ofx

Version imprimable

02/03/2016, 00h42
petitlou

macro vba import fichier bancaire ofx

Bonjour, je voudrais importer sous excel un fichier de relevé bancaire au format ofx.

Savez vous ou je pourrais trouver une macro de ce type ? :roll:
J'ai quelques connaissances très basique en macro vba , mais je ne sais pas par ou commencer.

merci
02/03/2016, 04h13
kiki29

Salut, extrait :

Citation:

Les fichiers OFX sont des Fichiers de données principalement associés avec Open Financial Exchange File.

Voir ici ou là , OFX ?
A priori cela s'apparente à du XML.
02/03/2016, 21h07
petitlou

Merci de ta réponse, il y a des infos intéressantes.
De mon coté j'avais déjà creusé pas mal sous Google, j'ai trouvé des logiciels pour transformer le fichier ofx en doc excel, mais je voulais gerer ça depuis excel dans une macro pour le fun :mouarf:

J'ai trouvé deux approches intéressantes, ici pour modifier le fichier ofx en un truc importable sous excel, mais je n'ai pas envie de bricoler tous les mois ces fichier a la main. Cela doit pouvoir se faire en automatique ...:?

Et une macro qui ne marche pas chez moi, mais c'est un point de départ !

Si j'arrive a mettre au point un truc qui marche je vous tiens au courant.

A+

cela fonctionne !

récupéré ici

Après avoir remplacé les "Sheet" de la macro d'origine par "Feuil" cela fonctionne:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Sub Parse_OFX()
 Dim Acct As String, _
 TextLine As String
 
 filenm = "text;" & Worksheets("Feuil1").Range("b1") & Worksheets("Feuil1").Range("b2") & Worksheets("Feuil1").Range("b3")
 
 Worksheets("Feuil2").Activate
 Cells.Select
 Selection.ClearContents
 Range("a1").Select
 Worksheets("Feuil3").Activate
 Cells.Select
 Selection.ClearContents
 Range("a1").Select
 
 
 Worksheets("Feuil2").Activate
 With ActiveSheet.QueryTables.Add(Connection:=filenm, Destination:=Range("a1"))
 .Name = "2009-10-10 to 2010-01-03 Checking 02.ofx"
 .FieldNames = True
 .RowNumbers = False
 .FillAdjacentFormulas = False
 .PreserveFormatting = True
 .RefreshOnFileOpen = False
 .RefreshStyle = xlInsertDeleteCells
 .SavePassword = False
 .SaveData = False
 .AdjustColumnWidth = True
 .RefreshPeriod = 0
 .TextFilePromptOnRefresh = False
 .TextFilePlatform = 437
 .TextFileStartRow = 1
 .TextFileParseType = xlDelimited
 .TextFileTextQualifier = xlTextQualifierNone
 .TextFileConsecutiveDelimiter = False
 .TextFileTabDelimiter = False
 .TextFileSemicolonDelimiter = False
 .TextFileCommaDelimiter = False
 .TextFileSpaceDelimiter = False
 .TextFileOtherDelimiter = ">"
 .TextFileColumnDataTypes = Array(2, 2)
 .TextFileTrailingMinusNumbers = True
 .Refresh BackgroundQuery:=False
 End With
 Range("a11").Select
 mrows = Worksheets("Feuil2").Rows.CurrentRegion.Count
 mrows = 900
 mcols = Worksheets("Feuil2").Range("A1").CurrentRegion.Columns.Count
 counter = 0
 For I = 1 To mrows
 Select Case Worksheets("Feuil2").Range("A1").Offset(I - 1)
 Case "<ACCTID"
 Acct = Worksheets("Feuil2").Range("A1").Offset(I - 1, 1)
 Worksheets("Feuil3").Range("A1").Offset(counter, 0) = "Account #: " & Acct
 counter = counter + 1
 Case "<TRNTYPE"
 Worksheets("Feuil3").Range("A1").Offset(counter, 1) = Worksheets("Feuil2").Range("A1").Offset(I - 1, 1)
 Case "<DTPOSTED"
 Worksheets("Feuil3").Range("A1").Offset(counter, 0) = OFX_Date(Worksheets("Feuil2").Range("A1").Offset(I - 1, 1))
 Case "<TRNAMT"
 Worksheets("Feuil3").Range("A1").Offset(counter, 6) = Val(Worksheets("Feuil2").Range("A1").Offset(I - 1, 1))
 Case "<CHECKNUM"
 Worksheets("Feuil3").Range("A1").Offset(counter, 2) = Worksheets("Feuil2").Range("A1").Offset(I - 1, 1)
 Case "<NAME"
 Worksheets("Feuil3").Range("A1").Offset(counter, 3) = Worksheets("Feuil2").Range("A1").Offset(I - 1, 1)
 Case "<MEMO"
 Worksheets("Feuil3").Range("A1").Offset(counter, 5) = Worksheets("Feuil2").Range("A1").Offset(I - 1, 1)
 Case "<REFNUM"
 Worksheets("Feuil3").Range("A1").Offset(counter, 2) = Worksheets("Feuil2").Range("A1").Offset(I - 1, 1)
 Case "</STMTTRN"
 counter = counter + 1
 Case Else
 End Select
 Next I
 
 End Sub
 Function OFX_Date(indate As String)
 OFX_Date = DateValue(Mid(indate, 5, 2) & "/" & Mid(indate, 7, 2) & "/" & Mid(indate, 1, 4))
 End Function

Avec un peu de mise en forme cela va très bien faire l'affaire

Par contre je trouve pas très sympa la façon de spécifier l'emplacement du fichier OFX à lire. A la place de noter dans les cases b1,b2,b3 de la feuille1 le nom et l'emplacement, peut on ouvrir une boite de dialogue Windows et aller chercher le fichier a la souris dans un répertoire ?

Merci;)

07/03/2016, 23h35
petitlou

il n'y a plus qu'a faire la synthese !!

ce que je cherche est sans doute la :

http://www.developpez.net/forums/d14...onner-fichier/

:mrgreen:

Question et réponse !

Voila le boulot terminé :mouarf: :mouarf: j'espère que cela pourra servir à d'autres !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Sub Parse_OFX()
 Dim Acct As String, _
 TextLine As String
 
 filenm = "text;" & Application.GetOpenFilename
 
 Worksheets("Feuil2").Activate
 Cells.Select
 Selection.ClearContents
 Range("a1").Select
 Worksheets("Feuil3").Activate
 Cells.Select
 Selection.ClearContents
 Range("a1").Select
 
 
 Worksheets("Feuil2").Activate
 With ActiveSheet.QueryTables.Add(Connection:=filenm, Destination:=Range("a1"))
 .Name = "2009-10-10 to 2010-01-03 Checking 02.ofx"
 .FieldNames = True
 .RowNumbers = False
 .FillAdjacentFormulas = False
 .PreserveFormatting = True
 .RefreshOnFileOpen = False
 .RefreshStyle = xlInsertDeleteCells
 .SavePassword = False
 .SaveData = False
 .AdjustColumnWidth = True
 .RefreshPeriod = 0
 .TextFilePromptOnRefresh = False
 .TextFilePlatform = 437
 .TextFileStartRow = 1
 .TextFileParseType = xlDelimited
 .TextFileTextQualifier = xlTextQualifierNone
 .TextFileConsecutiveDelimiter = False
 .TextFileTabDelimiter = False
 .TextFileSemicolonDelimiter = False
 .TextFileCommaDelimiter = False
 .TextFileSpaceDelimiter = False
 .TextFileOtherDelimiter = ">"
 .TextFileColumnDataTypes = Array(2, 2)
 .TextFileTrailingMinusNumbers = True
 .Refresh BackgroundQuery:=False
 End With
 Range("a11").Select
 mrows = Worksheets("Feuil2").Rows.CurrentRegion.Count
 mrows = 900
 mcols = Worksheets("Feuil2").Range("A1").CurrentRegion.Columns.Count
 counter = 0
 For I = 1 To mrows
 Select Case Worksheets("Feuil2").Range("A1").Offset(I - 1)
 Case "<ACCTID"
 Acct = Worksheets("Feuil2").Range("A1").Offset(I - 1, 1)
 Worksheets("Feuil3").Range("A1").Offset(counter, 0) = "Account #: " & Acct
 counter = counter + 1
 Case "<TRNTYPE"
 Worksheets("Feuil3").Range("A1").Offset(counter, 1) = Worksheets("Feuil2").Range("A1").Offset(I - 1, 1)
 Case "<DTPOSTED"
 Worksheets("Feuil3").Range("A1").Offset(counter, 0) = OFX_Date(Worksheets("Feuil2").Range("A1").Offset(I - 1, 1))
 Case "<TRNAMT"
 Worksheets("Feuil3").Range("A1").Offset(counter, 6) = Val(Worksheets("Feuil2").Range("A1").Offset(I - 1, 1))
 Case "<CHECKNUM"
 Worksheets("Feuil3").Range("A1").Offset(counter, 2) = Worksheets("Feuil2").Range("A1").Offset(I - 1, 1)
 Case "<NAME"
 Worksheets("Feuil3").Range("A1").Offset(counter, 3) = Worksheets("Feuil2").Range("A1").Offset(I - 1, 1)
 Case "<MEMO"
 Worksheets("Feuil3").Range("A1").Offset(counter, 5) = Worksheets("Feuil2").Range("A1").Offset(I - 1, 1)
 Case "<REFNUM"
 Worksheets("Feuil3").Range("A1").Offset(counter, 2) = Worksheets("Feuil2").Range("A1").Offset(I - 1, 1)
 Case "</STMTTRN"
 counter = counter + 1
 Case Else
 End Select
 Next I
 
 End Sub
 Function OFX_Date(indate As String)
 OFX_Date = DateValue(Mid(indate, 5, 2) & "/" & Mid(indate, 7, 2) & "/" & Mid(indate, 1, 4))
 End Function

13/02/2024, 18h03
fergut

des renseignements pour convertir données en .xlsx en .ofx

Bonjour.

Je souhaiterais des renseignements complémentaires.

Est-ce possible d'en avoir

Dans cette attente

Merci