macro vba import fichier bancaire ofx

**petitlou** · 02/03/2016, 00h42

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 ?

J'ai quelques connaissances très basique en macro vba , mais je ne sais pas par ou commencer.

merci

**kiki29** · 02/03/2016, 04h13

Salut, extrait :

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.

**petitlou** · 02/03/2016, 21h07

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

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+

**petitlou** · 07/03/2016, 22h58

récupéré ici

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

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
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

**petitlou** · 07/03/2016, 23h35

ce que je cherche est sans doute la :

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

**petitlou** · 08/03/2016, 00h03

Voila le boulot terminé

j'espère que cela pourra servir à d'autres !

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
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

macro vba import fichier bancaire ofx [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager