Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

VBA Importer des données pour tous les jours du mois

7 réponses
Avatar
Céline Brien
Bonjour à tous,
Bonne Année 2007 !
J'ai trouvé une macro qui importer des données d'un fichier PRN vers un
fichier Excel. Elle fonctionne très bien.
Mes données sont situées dans le dossier R:\Report\
Un dossier par mois :
Janv
Fev
Je dois importer les données d'un fichier PRN par jour :
01jan06.prn
02jan06.prn
03jan06.prn
J'ai pensé créer un fichier d'importation par mois et répéter les codes pour
chacun des jours. Voir codes ci-après.
Avez-vous des idées pour simplifier le tout. Une boucle ? Un seul fichier
avec référence à des cellules pour indiquer le mois et les jours ?
Merci de votre aide,
Céline
------------------------------------
Sub Importer()
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture
d'Excel
StrPath = "R:\Report\Jan\" 'Chemin d'accès du fichier
If Right(StrPath, 1) <> "\" Then StrPath = StrPath & "\" 'Ajoute \ à la
fin s'il y en a pas
StrFich = "01jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon Largeur
fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True, , ,
True
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en
motifiant l'extension et en mode partagé pour éviter des erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
StrFich = "02jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon Largeur
fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True, , ,
True
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en
motifiant l'extension et en mode partagé pour éviter des erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If

'Fermeture d'Excel
waExcel.Application.Quit
End Sub

7 réponses

Avatar
h2so4
bonsoir,

je t'ai mis une boucle, je n'ai pas testé !


Sub Importer()
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture
d'Excel
'---------------
for i=1 to 31
'---------------
StrPath = "R:ReportJan" 'Chemin d'accès du fichier
If Right(StrPath, 1) <> "" Then StrPath = StrPath & "" 'Ajoute à la
fin s'il y en a pas
'---------------
StrFich = format(i,"00") & "jan06.prn" 'Nom du fichier
'---------------
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon Largeur
fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True, , ,
True
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en
motifiant l'extension et en mode partagé pour éviter des erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
'--------------
next i
'-------------
'Fermeture d'Excel
waExcel.Application.Quit
End Sub
Avatar
FxM
Bonsoir Céline,

Reçois également nos voeux pour cette nouvelle année. Bonheur,
prospérité, santé et tout et tout !

Pour ton problème, il faudrait que tu parcoures les sous-répertoires
pour trouver les fichiers *.prn avant de les traiter 1 par 1.

En Excel normal, ca pourrait donner :
With application.filesearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.prn"
.execute
if .foundfiles.count > 0 then
For i = 1 To .FoundFiles.Count
' ................
Next i
end if
end with


Ce qui pourrait donner dans ta macro (non testé) :
Attention aux coupures de ligne !

Sub Importer2()
StrPath = "R:Report"

Dim waExcel
Set waExcel = CreateObject("Excel.Application")
waExcel.Visible = False
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.prn"
.Execute
If .FoundFiles.Count > 0 Then
For i = 1 To .FoundFiles.Count
If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then
StrFich = Dir(.FoundFiles(i))

waExcel.Workbooks.OpenText .FoundFiles(i), , , 2, , , True, , , True

waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
Next i
End If
End With
End With
waExcel.Application.Quit
End Sub

@+
FxM


Bonjour à tous,
Bonne Année 2007 !
J'ai trouvé une macro qui importer des données d'un fichier PRN vers un
fichier Excel. Elle fonctionne très bien.
Mes données sont situées dans le dossier R:Report
Un dossier par mois :
Janv
Fev
Je dois importer les données d'un fichier PRN par jour :
01jan06.prn
02jan06.prn
03jan06.prn
J'ai pensé créer un fichier d'importation par mois et répéter les codes pour
chacun des jours. Voir codes ci-après.
Avez-vous des idées pour simplifier le tout. Une boucle ? Un seul fichier
avec référence à des cellules pour indiquer le mois et les jours ?
Merci de votre aide,
Céline
------------------------------------
Sub Importer()
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture
d'Excel
StrPath = "R:ReportJan" 'Chemin d'accès du fichier
If Right(StrPath, 1) <> "" Then StrPath = StrPath & "" 'Ajoute à la
fin s'il y en a pas
StrFich = "01jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon Largeur
fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True, , ,
True
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en
motifiant l'extension et en mode partagé pour éviter des erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
StrFich = "02jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon Largeur
fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True, , ,
True
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en
motifiant l'extension et en mode partagé pour éviter des erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If

'Fermeture d'Excel
waExcel.Application.Quit
End Sub




Avatar
Céline Brien
Merci pour vos réponses.
Je vais tester le tout et je vous reviens.
Céline

"FxM" a écrit dans le message de news:
Oo1PG%
Bonsoir Céline,

Reçois également nos voeux pour cette nouvelle année. Bonheur, prospérité,
santé et tout et tout !

Pour ton problème, il faudrait que tu parcoures les sous-répertoires pour
trouver les fichiers *.prn avant de les traiter 1 par 1.

En Excel normal, ca pourrait donner :
With application.filesearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.prn"
.execute
if .foundfiles.count > 0 then
For i = 1 To .FoundFiles.Count
' ................
Next i
end if
end with


Ce qui pourrait donner dans ta macro (non testé) :
Attention aux coupures de ligne !

Sub Importer2()
StrPath = "R:Report"

Dim waExcel
Set waExcel = CreateObject("Excel.Application")
waExcel.Visible = False
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.prn"
.Execute
If .FoundFiles.Count > 0 Then
For i = 1 To .FoundFiles.Count
If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then
StrFich = Dir(.FoundFiles(i))

waExcel.Workbooks.OpenText .FoundFiles(i), , , 2, , , True, , , True

waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
Next i
End If
End With
End With
waExcel.Application.Quit
End Sub

@+
FxM


Bonjour à tous,
Bonne Année 2007 !
J'ai trouvé une macro qui importer des données d'un fichier PRN vers un
fichier Excel. Elle fonctionne très bien.
Mes données sont situées dans le dossier R:Report
Un dossier par mois :
Janv
Fev
Je dois importer les données d'un fichier PRN par jour :
01jan06.prn
02jan06.prn
03jan06.prn
J'ai pensé créer un fichier d'importation par mois et répéter les codes
pour chacun des jours. Voir codes ci-après.
Avez-vous des idées pour simplifier le tout. Une boucle ? Un seul fichier
avec référence à des cellules pour indiquer le mois et les jours ?
Merci de votre aide,
Céline
------------------------------------
Sub Importer()
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture
d'Excel
StrPath = "R:ReportJan" 'Chemin d'accès du fichier
If Right(StrPath, 1) <> "" Then StrPath = StrPath & "" 'Ajoute à
la fin s'il y en a pas
StrFich = "01jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon Largeur
fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True, ,
, True
'Sauvegarde la feuiller importer vers le chemin d'accès de départ
en motifiant l'extension et en mode partagé pour éviter des erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
StrFich = "02jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon Largeur
fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True, ,
, True
'Sauvegarde la feuiller importer vers le chemin d'accès de départ
en motifiant l'extension et en mode partagé pour éviter des erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If

'Fermeture d'Excel
waExcel.Application.Quit
End Sub




Avatar
Céline Brien
Bonjour à tous,
Bonjour s2ho4,
Bonjour FxM,
J'ai testé la solution de FxM et elle fonctionne très bien. Merci beaucoup,
beaucoup, beaucoup !
J'ai opté pour cette solution, car les fichiers n'ont pas besoin d'être
nommés. Donc la macro fonctionne pour tous les mois... sauf pour la première
ligne :
StrPath = "R:ReportJan"
Je vais voir si je peux récupérer une partie du nom du fichier.
En effet, le fichier contenant la macro à exécuter sera enregistré sous à
chaque mois.
Jan07.xls deviendra Feb07.xls et ensuite Mar07.xls et etc.
Les fichiers du mois sont dans un dossier portant le nom du mois :
R:ReportJan et R:ReportFeb et R:ReportMar
Je vais tenter de récupérer les trois premières lettres du nom du fichier
dans la première ligne de la macro.
Merci encore pour votre aide si précieuse.
Bon dimanche à tous,
Céline

"FxM" a écrit dans le message de news:
Oo1PG%
Bonsoir Céline,

Reçois également nos voeux pour cette nouvelle année. Bonheur, prospérité,
santé et tout et tout !

Pour ton problème, il faudrait que tu parcoures les sous-répertoires pour
trouver les fichiers *.prn avant de les traiter 1 par 1.

En Excel normal, ca pourrait donner :
With application.filesearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.prn"
.execute
if .foundfiles.count > 0 then
For i = 1 To .FoundFiles.Count
' ................
Next i
end if
end with


Ce qui pourrait donner dans ta macro (non testé) :
Attention aux coupures de ligne !

Sub Importer2()
StrPath = "R:Report"

Dim waExcel
Set waExcel = CreateObject("Excel.Application")
waExcel.Visible = False
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.prn"
.Execute
If .FoundFiles.Count > 0 Then
For i = 1 To .FoundFiles.Count
If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then
StrFich = Dir(.FoundFiles(i))

waExcel.Workbooks.OpenText .FoundFiles(i), , , 2, , , True, , , True

waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
Next i
End If
End With
End With
waExcel.Application.Quit
End Sub

@+
FxM


Bonjour à tous,
Bonne Année 2007 !
J'ai trouvé une macro qui importer des données d'un fichier PRN vers un
fichier Excel. Elle fonctionne très bien.
Mes données sont situées dans le dossier R:Report
Un dossier par mois :
Janv
Fev
Je dois importer les données d'un fichier PRN par jour :
01jan06.prn
02jan06.prn
03jan06.prn
J'ai pensé créer un fichier d'importation par mois et répéter les codes
pour chacun des jours. Voir codes ci-après.
Avez-vous des idées pour simplifier le tout. Une boucle ? Un seul fichier
avec référence à des cellules pour indiquer le mois et les jours ?
Merci de votre aide,
Céline
------------------------------------
Sub Importer()
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture
d'Excel
StrPath = "R:ReportJan" 'Chemin d'accès du fichier
If Right(StrPath, 1) <> "" Then StrPath = StrPath & "" 'Ajoute à
la fin s'il y en a pas
StrFich = "01jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon Largeur
fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True, ,
, True
'Sauvegarde la feuiller importer vers le chemin d'accès de départ
en motifiant l'extension et en mode partagé pour éviter des erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
StrFich = "02jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon Largeur
fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True, ,
, True
'Sauvegarde la feuiller importer vers le chemin d'accès de départ
en motifiant l'extension et en mode partagé pour éviter des erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If

'Fermeture d'Excel
waExcel.Application.Quit
End Sub




Avatar
FxM
Bonsoir Céline,

Merci du feedback.

Si tu places ton fichier directement dans le sous-répertoire, tu
pourrais utiliser StrPath = thisworkbook.path

Si tu as toujours trois lettres pour débuter le nom de fichier, ca peut
relever du StrPath = "R:Report" & left(thisworkbook.name,3)

Si à l'inverse, tu as tjrs l'année en deux chiffres suivi de ".xls",
vois pour StrPath = "R:Report" &
left(thisworkbook.name,len(thisworkbook.name)-6)

@+
FxM


Bonjour à tous,
Bonjour s2ho4,
Bonjour FxM,
J'ai testé la solution de FxM et elle fonctionne très bien. Merci beaucoup,
beaucoup, beaucoup !
J'ai opté pour cette solution, car les fichiers n'ont pas besoin d'être
nommés. Donc la macro fonctionne pour tous les mois... sauf pour la première
ligne :
StrPath = "R:ReportJan"
Je vais voir si je peux récupérer une partie du nom du fichier.
En effet, le fichier contenant la macro à exécuter sera enregistré sous à
chaque mois.
Jan07.xls deviendra Feb07.xls et ensuite Mar07.xls et etc.
Les fichiers du mois sont dans un dossier portant le nom du mois :
R:ReportJan et R:ReportFeb et R:ReportMar
Je vais tenter de récupérer les trois premières lettres du nom du fichier
dans la première ligne de la macro.
Merci encore pour votre aide si précieuse.
Bon dimanche à tous,
Céline

"FxM" a écrit dans le message de news:
Oo1PG%
Bonsoir Céline,

Reçois également nos voeux pour cette nouvelle année. Bonheur, prospérité,
santé et tout et tout !

Pour ton problème, il faudrait que tu parcoures les sous-répertoires pour
trouver les fichiers *.prn avant de les traiter 1 par 1.

En Excel normal, ca pourrait donner :
With application.filesearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.prn"
.execute
if .foundfiles.count > 0 then
For i = 1 To .FoundFiles.Count
' ................
Next i
end if
end with


Ce qui pourrait donner dans ta macro (non testé) :
Attention aux coupures de ligne !

Sub Importer2()
StrPath = "R:Report"

Dim waExcel
Set waExcel = CreateObject("Excel.Application")
waExcel.Visible = False
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.prn"
.Execute
If .FoundFiles.Count > 0 Then
For i = 1 To .FoundFiles.Count
If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then
StrFich = Dir(.FoundFiles(i))

waExcel.Workbooks.OpenText .FoundFiles(i), , , 2, , , True, , , True

waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
Next i
End If
End With
End With
waExcel.Application.Quit
End Sub

@+
FxM


Bonjour à tous,
Bonne Année 2007 !
J'ai trouvé une macro qui importer des données d'un fichier PRN vers un
fichier Excel. Elle fonctionne très bien.
Mes données sont situées dans le dossier R:Report
Un dossier par mois :
Janv
Fev
Je dois importer les données d'un fichier PRN par jour :
01jan06.prn
02jan06.prn
03jan06.prn
J'ai pensé créer un fichier d'importation par mois et répéter les codes
pour chacun des jours. Voir codes ci-après.
Avez-vous des idées pour simplifier le tout. Une boucle ? Un seul fichier
avec référence à des cellules pour indiquer le mois et les jours ?
Merci de votre aide,
Céline
------------------------------------
Sub Importer()
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture
d'Excel
StrPath = "R:ReportJan" 'Chemin d'accès du fichier
If Right(StrPath, 1) <> "" Then StrPath = StrPath & "" 'Ajoute à
la fin s'il y en a pas
StrFich = "01jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon Largeur
fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True, ,
, True
'Sauvegarde la feuiller importer vers le chemin d'accès de départ
en motifiant l'extension et en mode partagé pour éviter des erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
StrFich = "02jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon Largeur
fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True, ,
, True
'Sauvegarde la feuiller importer vers le chemin d'accès de départ
en motifiant l'extension et en mode partagé pour éviter des erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If

'Fermeture d'Excel
waExcel.Application.Quit
End Sub








Avatar
Céline Brien
Bonsoir à tous,
Bonsoir FxM,
De nouveau merci pour ton aide. J'apprécie énormément !
La deuxième solution est très intéressante si on veut enregistrer les noms
de fichier en français (ou presque...) donc parfois plus que 3 lettres :
janv, fev, mars, avril, mai, juin, juil, aout, sept, oct, nov, dec.
@+ +
Céline

Je vais tester tes propositions.
"FxM" a écrit dans le message de news:
%23S1RJ3$
Bonsoir Céline,

Merci du feedback.

Si tu places ton fichier directement dans le sous-répertoire, tu pourrais
utiliser StrPath = thisworkbook.path

Si tu as toujours trois lettres pour débuter le nom de fichier, ca peut
relever du StrPath = "R:Report" & left(thisworkbook.name,3)

Si à l'inverse, tu as tjrs l'année en deux chiffres suivi de ".xls", vois
pour StrPath = "R:Report" &
left(thisworkbook.name,len(thisworkbook.name)-6)

@+
FxM


Bonjour à tous,
Bonjour s2ho4,
Bonjour FxM,
J'ai testé la solution de FxM et elle fonctionne très bien. Merci
beaucoup, beaucoup, beaucoup !
J'ai opté pour cette solution, car les fichiers n'ont pas besoin d'être
nommés. Donc la macro fonctionne pour tous les mois... sauf pour la
première ligne :
StrPath = "R:ReportJan"
Je vais voir si je peux récupérer une partie du nom du fichier.
En effet, le fichier contenant la macro à exécuter sera enregistré sous à
chaque mois.
Jan07.xls deviendra Feb07.xls et ensuite Mar07.xls et etc.
Les fichiers du mois sont dans un dossier portant le nom du mois :
R:ReportJan et R:ReportFeb et R:ReportMar
Je vais tenter de récupérer les trois premières lettres du nom du fichier
dans la première ligne de la macro.
Merci encore pour votre aide si précieuse.
Bon dimanche à tous,
Céline

"FxM" a écrit dans le message de news:
Oo1PG%
Bonsoir Céline,

Reçois également nos voeux pour cette nouvelle année. Bonheur,
prospérité, santé et tout et tout !

Pour ton problème, il faudrait que tu parcoures les sous-répertoires
pour trouver les fichiers *.prn avant de les traiter 1 par 1.

En Excel normal, ca pourrait donner :
With application.filesearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.prn"
.execute
if .foundfiles.count > 0 then
For i = 1 To .FoundFiles.Count
' ................
Next i
end if
end with


Ce qui pourrait donner dans ta macro (non testé) :
Attention aux coupures de ligne !

Sub Importer2()
StrPath = "R:Report"

Dim waExcel
Set waExcel = CreateObject("Excel.Application")
waExcel.Visible = False
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.prn"
.Execute
If .FoundFiles.Count > 0 Then
For i = 1 To .FoundFiles.Count
If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then
StrFich = Dir(.FoundFiles(i))

waExcel.Workbooks.OpenText .FoundFiles(i), , , 2, , , True, , ,
True

waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
Next i
End If
End With
End With
waExcel.Application.Quit
End Sub

@+
FxM


Bonjour à tous,
Bonne Année 2007 !
J'ai trouvé une macro qui importer des données d'un fichier PRN vers un
fichier Excel. Elle fonctionne très bien.
Mes données sont situées dans le dossier R:Report
Un dossier par mois :
Janv
Fev
Je dois importer les données d'un fichier PRN par jour :
01jan06.prn
02jan06.prn
03jan06.prn
J'ai pensé créer un fichier d'importation par mois et répéter les codes
pour chacun des jours. Voir codes ci-après.
Avez-vous des idées pour simplifier le tout. Une boucle ? Un seul
fichier avec référence à des cellules pour indiquer le mois et les
jours ?
Merci de votre aide,
Céline
------------------------------------
Sub Importer()
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture
d'Excel
StrPath = "R:ReportJan" 'Chemin d'accès du fichier
If Right(StrPath, 1) <> "" Then StrPath = StrPath & "" 'Ajoute
à la fin s'il y en a pas
StrFich = "01jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon
Largeur fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True,
, , True
'Sauvegarde la feuiller importer vers le chemin d'accès de
départ en motifiant l'extension et en mode partagé pour éviter des
erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
StrFich = "02jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon
Largeur fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True,
, , True
'Sauvegarde la feuiller importer vers le chemin d'accès de
départ en motifiant l'extension et en mode partagé pour éviter des
erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If

'Fermeture d'Excel
waExcel.Application.Quit
End Sub









Avatar
FxM
Bonjour Céline,

Merci, z'en prie :o)

Sous Excel 2000+, il y a aussi les split et join que l'on oublie trop
souvent :
tablo = split(thisworkbook.fullname,"")
tablo(ubound(tablo)) = ""
StrPath = join(tablo,"")

et bien d'autres encore :o)

@+
FxM



Bonsoir à tous,
Bonsoir FxM,
De nouveau merci pour ton aide. J'apprécie énormément !
La deuxième solution est très intéressante si on veut enregistrer les noms
de fichier en français (ou presque...) donc parfois plus que 3 lettres :
janv, fev, mars, avril, mai, juin, juil, aout, sept, oct, nov, dec.
@+ +
Céline

Je vais tester tes propositions.
"FxM" a écrit dans le message de news:
%23S1RJ3$
Bonsoir Céline,

Merci du feedback.

Si tu places ton fichier directement dans le sous-répertoire, tu pourrais
utiliser StrPath = thisworkbook.path

Si tu as toujours trois lettres pour débuter le nom de fichier, ca peut
relever du StrPath = "R:Report" & left(thisworkbook.name,3)

Si à l'inverse, tu as tjrs l'année en deux chiffres suivi de ".xls", vois
pour StrPath = "R:Report" &
left(thisworkbook.name,len(thisworkbook.name)-6)

@+
FxM


Bonjour à tous,
Bonjour s2ho4,
Bonjour FxM,
J'ai testé la solution de FxM et elle fonctionne très bien. Merci
beaucoup, beaucoup, beaucoup !
J'ai opté pour cette solution, car les fichiers n'ont pas besoin d'être
nommés. Donc la macro fonctionne pour tous les mois... sauf pour la
première ligne :
StrPath = "R:ReportJan"
Je vais voir si je peux récupérer une partie du nom du fichier.
En effet, le fichier contenant la macro à exécuter sera enregistré sous à
chaque mois.
Jan07.xls deviendra Feb07.xls et ensuite Mar07.xls et etc.
Les fichiers du mois sont dans un dossier portant le nom du mois :
R:ReportJan et R:ReportFeb et R:ReportMar
Je vais tenter de récupérer les trois premières lettres du nom du fichier
dans la première ligne de la macro.
Merci encore pour votre aide si précieuse.
Bon dimanche à tous,
Céline

"FxM" a écrit dans le message de news:
Oo1PG%
Bonsoir Céline,

Reçois également nos voeux pour cette nouvelle année. Bonheur,
prospérité, santé et tout et tout !

Pour ton problème, il faudrait que tu parcoures les sous-répertoires
pour trouver les fichiers *.prn avant de les traiter 1 par 1.

En Excel normal, ca pourrait donner :
With application.filesearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.prn"
.execute
if .foundfiles.count > 0 then
For i = 1 To .FoundFiles.Count
' ................
Next i
end if
end with


Ce qui pourrait donner dans ta macro (non testé) :
Attention aux coupures de ligne !

Sub Importer2()
StrPath = "R:Report"

Dim waExcel
Set waExcel = CreateObject("Excel.Application")
waExcel.Visible = False
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.prn"
.Execute
If .FoundFiles.Count > 0 Then
For i = 1 To .FoundFiles.Count
If UCase(Left(.FoundFiles(i), Len(StrPath))) = UCase(StrPath) Then
StrFich = Dir(.FoundFiles(i))

waExcel.Workbooks.OpenText .FoundFiles(i), , , 2, , , True, , ,
True

waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
Next i
End If
End With
End With
waExcel.Application.Quit
End Sub

@+
FxM


Bonjour à tous,
Bonne Année 2007 !
J'ai trouvé une macro qui importer des données d'un fichier PRN vers un
fichier Excel. Elle fonctionne très bien.
Mes données sont situées dans le dossier R:Report
Un dossier par mois :
Janv
Fev
Je dois importer les données d'un fichier PRN par jour :
01jan06.prn
02jan06.prn
03jan06.prn
J'ai pensé créer un fichier d'importation par mois et répéter les codes
pour chacun des jours. Voir codes ci-après.
Avez-vous des idées pour simplifier le tout. Une boucle ? Un seul
fichier avec référence à des cellules pour indiquer le mois et les
jours ?
Merci de votre aide,
Céline
------------------------------------
Sub Importer()
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture
d'Excel
StrPath = "R:ReportJan" 'Chemin d'accès du fichier
If Right(StrPath, 1) <> "" Then StrPath = StrPath & "" 'Ajoute
à la fin s'il y en a pas
StrFich = "01jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon
Largeur fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True,
, , True
'Sauvegarde la feuiller importer vers le chemin d'accès de
départ en motifiant l'extension et en mode partagé pour éviter des
erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If
StrFich = "02jan06.prn" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon
Largeur fixe avec délimiteur : Tabulation et Space
waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , True,
, , True
'Sauvegarde la feuiller importer vers le chemin d'accès de
départ en motifiant l'extension et en mode partagé pour éviter des
erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich,
Len(StrFich) - 4) & ".xls", , , , , , 2
End If

'Fermeture d'Excel
waExcel.Application.Quit
End Sub