Macro d'import de données externes

Bonjour,

Je souhaite importer des fichiers csv dans Excel pour pouvoir faire des traitements en masse. La base de données me permettant de générer les csv étant en UTF-8 je suis obligée de passer par données/données externe pour lui indiquer le bon encodage.

J'ai enregistré une macro pour récupérer le code me permettant de faire ces différentes actions. L'erreur appararait sur la ligne : .Refresh BackgroundQuery:=False => "Erreur Automation L'objet invoqué s'est déconnecté de ses clients" et parfois "Erreur 1004 Erreur définie par l'application ou par objet". J'ai recherché des solutions un peu partout sans succès... Avez vous des idées pour résoudre ce problème?

Merci beaucoup!

Voici la partie du code en question :

With ActiveSheet.QueryTables.Add(Connection:= _

"TEXT;" & lien & Monfichier _

, Destination:=Range("A1"))

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.TextFilePromptOnRefresh = False

.TextFilePlatform = -535

.TextFileStartRow = 1

.TextFileParseType = xlDelimited

.TextFileTextQualifier = xlTextQualifierDoubleQuote

.TextFileConsecutiveDelimiter = False

.TextFileTabDelimiter = True

.TextFileSemicolonDelimiter = False

.TextFileCommaDelimiter = False

.TextFileSpaceDelimiter = False

.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)

.TextFileTrailingMinusNumbers = True

.Refresh BackgroundQuery:=False

End With

Bonjour,

Donner la macro au complet SVP

A+

Voici la macro complète.

J'ai utilisé le mot "lien" pour remplacer le lien vers le dossier où se trouvent tous les csv

Merci par avance

Option Explicit

Sub tableau_hydrant_automatique()

Dim Monfichier As String

Dim Nom_classeur As String 'variable qui contient le nom du classeur

If ActiveWorkbook Is Nothing Then 'teste si un classeur est déjà ouvert si oui, on le ferme si non, on ne fait rien

Else

Nom_classeur = ActiveWorkbook.Name

Workbooks(Nom_classeur).Close

End If

ChDir "lien" 'l'instruction ChDir permet de se positionner sur un répertoire précis

Monfichier = Dir("*.*") 'sélectionne tous les fichiers du répertoire

While Monfichier <> ""

Workbooks.Add

With ActiveSheet.QueryTables.Add(Connection:= _

"TEXT;lien" & Monfichier _

, Destination:=Range("A1"))

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.TextFilePromptOnRefresh = False

.TextFilePlatform = -535

.TextFileStartRow = 1

.TextFileParseType = xlDelimited

.TextFileTextQualifier = xlTextQualifierDoubleQuote

.TextFileConsecutiveDelimiter = False

.TextFileTabDelimiter = True

.TextFileSemicolonDelimiter = False

.TextFileCommaDelimiter = False

.TextFileSpaceDelimiter = False

.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)

.TextFileTrailingMinusNumbers = True

.Refresh BackgroundQuery:=False

End With

ActiveWorkbook.SaveAs Filename:= _

"lien" & Left(Monfichier, InStr(Monfichier, ".csv") - 1) & ".xls" _

, FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _

ReadOnlyRecommended:=False, CreateBackup:=False 'enregistre le fichier .csv en .xls en gardant le même nom

Monfichier = Dir()

Wend

Do 'boucle jusqu'à ce qu'il n'y ait plus de classeur excel ouvert

Application.Run "PERSO.XLS!hydrants" 'exécution de la macro hydrant

ActiveWorkbook.Save

ActiveWorkbook.Close 'ferme le classeur courant

Loop Until Workbooks.Count = 1 'execute la boucle jusqu'au dernier classeur ouvert

End Sub

Bonsoir,

Je n'ai pas d'idée particulière et comme on n'a pas les moyens de tester...

Peut-être que quelqu'un d'autre aura une lumière à apporter ?

Désolé.

A+

Salut le forum

Ouvre le fichier et traite le ensuite

Sub Import_CSV()
  Dim Fichier As String
    Fichier = "blablabla.csv"
    Workbooks.Open Filename:=Fichier
End Sub

Mytå

Bonjour tou(te)s,

Comme dit Mytä, ouvre le fichier.

Dans ta configuration tu marque que tu est avec Excel 2007 ? suffit alors de le sauver sous xlsx, il n'y a aucun traitement a faire Excel se charge de la mise en colonne.

Si ça ne fonctionne pas et que malgré tout tu dois passer par une connection...

1°) en manuel

-> Données -> Connections

Tu supprime toutes les connections qui y sont déjà.

2°) dans la macro

METTRE UN POINT DEVANT TOUS LES PARAMÈTRES ??

Supprimer la ligne -> .Refresh BackgroundQuery:=False

La remplacer par .Delete

Normalement Connection est employer pour connecter une base de données et une fois que c'est fait ça fait partie du classeur.

3°) Et là je me demande bien ce que tu veux faire...

If ActiveWorkbook Is Nothing Then 'teste si un classeur est déjà ouvert si oui, on le ferme si non, on ne fait rien
Else
Nom_classeur = ActiveWorkbook.Name
Workbooks(Nom_classeur).Close
End If

Tu peu carrément supprimer ces lignes, elles ne servent qu'a te procurer de temps en temps (suivant les circonstances) ton erreur 1004.

A+

PS : quel genre de fichier tu veux sauver avec FileFormat:=xlExcel9795 ?

Bonjour à tous,

Tout d'abord un grand merci à tous pour votre aide.

Mytå : j'ai testé ta solution d'ouverture de fichier, le problème est que Excel ouvre le fichier dans la même colonne. De plus comme je ne lui indique pas l'encodage, il ne me l'ouvre pas en UTF-8 donc j'ai toujours le problème avec mes caractères spéciaux...

lermite : c'est vrai que je ne l'ai pas mentionné mais contrairement à ce qui est inscrit dans mon profil pour cette macro j'utilise Excel 2003.

Pour tes solutions :

1) cela fonctionne bien en manuel à partir de données/ données externe car la je peux lui indiquer l'encodage, le problème est que le traitement que je souhaite réaliser est sur un très grand nombre de fichier, je voudrais donc l'automatiser.

2) que veux tu dire par "METTRE UN POINT DEVANT TOUS LES PARAMÈTRES ?? "

Lorsque je supprime le .Refresh BackgroundQuery:=False et que je le remplacer par .Delete, la macro s'exécute jusqu'à la fin, le problème est que dans le classeur les données ne sont pas apparues...

3)

    If ActiveWorkbook Is Nothing Then  'teste si un classeur est déjà ouvert si oui, on le ferme si non, on ne fait rien
    Else
    Nom_classeur = ActiveWorkbook.Name
    Workbooks(Nom_classeur).Close
    End If

Cette partie me sert à vérifier s'il y a déjà un classeur d'ouvert dans ce cas je le ferme. Je fais cette manipulation car je fais une boucle qui exécute une autre macro jusqu'à ce qu'il n'y ait plus de classeur ouvert, s'il en reste un, ma macro ne fonctionne plus car elle ne trouve pas les données :

Do 'boucle jusqu'à ce qu'il n'y ait plus de classeur excel ouvert
Application.Run "PERSO.XLS!hydrants" 'exécution de la macro hydrant
ActiveWorkbook.Save
ActiveWorkbook.Close 'ferme le classeur courant
Loop Until Workbooks.Count = 1 'execute la boucle jusqu'au dernier classeur ouvert

S'il y a une autre solution je suis preneuse!

Je n'ai toujours pas trouvé de solutions pour l'import...

Merci encore

Ça y est ça fonctionne!! Alors je suis partie de la remarque 3) de lermite avec la partie de code qui pouvait poser problème :

    If ActiveWorkbook Is Nothing Then   'teste si un classeur est déjà ouvert si oui, on le ferme si non, on ne fait rien
   Else
    Nom_classeur = ActiveWorkbook.Name
    Workbooks(Nom_classeur).Close
    End If

Je l'ai supprimé ainsi que ma boucle do. J'ai contourné le problème en rajoutant dans la boucle WHILE le contenu qu'il y avait initialement dans la boucle DO , comme ça je n'ai plus besoin de tester s'il y a un classeur ouvert...

A priori le fait d'avoir supprimé ce test a résolu mon problème de .Refresh BackgroundQuery:=False

Je vous remercie encore pour vos conseils et votre aide