Macros importation de données

[Nric]

Bonjour,

Je souhaite créer un macro afin d'importer les données provenant d'un fichier .xls ou .csv. Pour ce faire j'ai lancé l'enregistreur de macro et j'ai obtenu le code d'import de fichier:




Sub Macro1()

With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\Documents and Settings\Eric\Bureau\données brutes.xls;" _
, _
"Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDBatabase " _
, _
"Password="""";Jet OLEDB:Engine Type=35;Jet OLEDBatabase Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk" _
, _
" Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet O" _
, _
"LEDBon't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("Feuil1$")
.Name = "données brutes"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = _
"C:\Documents and Settings\Eric\Bureau\données brutes.xls"
.Refresh BackgroundQuery:=False
End With
End Sub





Maintenant je souhaite modifier ce code pour pouvoir sélectionner le fichier à importer. Pour ce faire j'ai modifié le code de la manière suivante:





Sub Macro1()


fileToOpen = Application.GetOpenFilename()

With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=fileToOpen ;" _
, _
"Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDBatabase " _
, _
"Password="""";Jet OLEDB:Engine Type=35;Jet OLEDBatabase Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk" _
, _
" Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet O" _
, _
"LEDBon't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("Feuil1$")
.Name = "données brutes"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = _
fileToOpen
.Refresh BackgroundQuery:=False
End With
End Sub





La boîte de dialogue s'affiche bien mais une fois le fichier sélectionné j'ai un message d'erreur qui apparaît:

Erreur d'exécution '1004':
Le moteur de base de données Microsoft Jet n'a pas pu trouver l'objet "Feuil1$". Assurez-vous que l'objet existe et que vous avez bien saisi son nom et son chemin d'accès.


Je ne comprend pas parce que les feuilles de mes fichiers portent le même nom, soit Feui1, Feuil2, etc.
Et chose encore plus bizarre, si je modifie le chemin manuellement dans le code, ça marche sans problèmes.

Je vous remercie de bien vouloir m'éclairer sur ce point.

Eric

 

[vbacrumble]

Re : Macros importation de données

Bonsoir


Tu peux aussi passer par l'assistant d'ouverture de fichier d'excel.

Sub Macro1()
' Macro1 Macro
' Macro enregistrée le 23/05/2009 par VBACrumble
    Workbooks.Open Filename:="C:\TEMP\test.xls"
ActiveWorkBook.Sheets("Feuil1").UsedRange.Copy
ThisWorkBook.Sheets(1).PasteSpecial xlValues
End Sub

PS: adapter le nom du dossier et le nom du fichier Excel.

 

[Nric]

Re : Macros importation de données

Salut,

merci de ta réponse mais le code ne marche malheureusement pas après remplacement du nom et du chemin du fichier.
J'ai un message d'erreur: erreur définie par l'application ou par l'objet.

De plus, je souhaite pouvoir sélectionner le fichier à partir d'une boîte de dialogue.

que dois-je modifier?

 

[vbacrumble]

Re : Macros importation de données

RE



Et avec ce code ci, ca fonctionne non ?

Sub importfichier()
Dim S_wk As Workbook, D_wk As Workbook, pc$
Set D_wk = ThisWorkbook
Application.ScreenUpdating = False
FICHIER = Application.GetOpenFilename("Fichier EXCEL (*.xls), *.xls")
    If FICHIER <> False Then
    Set S_wk = Workbooks.Open(FICHIER)

    With S_wk
        With .ActiveSheet.UsedRange
            pc = .Cells(1, 1).Address
            .Copy
        End With
        Set D_wk = ThisWorkbook
        D_wk.ActiveSheet.Range(pc).PasteSpecial xlValues
Application.CutCopyMode = False
        .Close False
    End With
    End If
    D_wk.ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub

 

[Nric]

Re : Macros importation de données

Ah merci beaucoup!! Ca marche parfaitement!

Je vais essayer de comprendre le code maintenant!

Thx a lot!

Eric