Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel VBA Copier des classeurs vers un autre dossier en les renommant mais sans les ouvrir

VBA Copier des classeurs vers un autre dossier en les renommant mais sans les ouvrir

3 réponses
Avatar
Céline Brien
Bonjour à tous,
Est-il possible de copier des classeurs vers un autre dossier en les
renommant, mais sans les ouvrir ?
Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me
semble que l'exécution serait plus rapide.
Vous trouverez ci-dessous des codes qui effectuent le travail, mais en
ouvrant les classeurs.
Merci de votre aide précieuse,
Céline
----------------------------------------
Sub ImporterNov()
'Chemin d'accès des fichiers du mois
StrPath = "R:\Report\Nov\"
StrPath2 = "R:\Report\PasTouche\"
'Supprimer les fichiers dans le dossier PasTouche
Kill "R:\Report\PasTouche\*.xls"
'Ouverture d'Excel
Dim waExcel
Set waExcel = CreateObject("Excel.Application")
'Rendre Excel invisible
waExcel.Visible = False
'Rechercher les fichiers xls, les compter et les sauvegarer du premier au
dernier dans PasTouche
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.xls"
.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))
'Ouvrir le fichier xls
waExcel.Workbooks.Open .FoundFiles(i)
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en
utilisant les 2 caractères à droite et en mode partagé pour éviter des
erreurs.
waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , , ,
, 2
End If
' waExcel.Workbooks.Close
waExcel.ActiveWorkbook.Close
Next i
End If
End With
'Fermeture d'Excel
waExcel.Application.Quit
End Sub
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
MichDenis
Évidemment le classeur doit être fermé.

Name "c:ancien_cheminClasseur1.xls" As "c:Nouveau_CheminClasseur1.xls"



"Céline Brien" a écrit dans le message de news:

Bonjour à tous,
Est-il possible de copier des classeurs vers un autre dossier en les
renommant, mais sans les ouvrir ?
Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me
semble que l'exécution serait plus rapide.
Vous trouverez ci-dessous des codes qui effectuent le travail, mais en
ouvrant les classeurs.
Merci de votre aide précieuse,
Céline
----------------------------------------
Sub ImporterNov()
'Chemin d'accès des fichiers du mois
StrPath = "R:ReportNov"
StrPath2 = "R:ReportPasTouche"
'Supprimer les fichiers dans le dossier PasTouche
Kill "R:ReportPasTouche*.xls"
'Ouverture d'Excel
Dim waExcel
Set waExcel = CreateObject("Excel.Application")
'Rendre Excel invisible
waExcel.Visible = False
'Rechercher les fichiers xls, les compter et les sauvegarer du premier au
dernier dans PasTouche
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.xls"
.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))
'Ouvrir le fichier xls
waExcel.Workbooks.Open .FoundFiles(i)
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en
utilisant les 2 caractères à droite et en mode partagé pour éviter des
erreurs.
waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , , ,
, 2
End If
' waExcel.Workbooks.Close
waExcel.ActiveWorkbook.Close
Next i
End If
End With
'Fermeture d'Excel
waExcel.Application.Quit
End Sub
Avatar
Céline Brien
Salut Mich,
Merci beaucoup pour ta réponse.
Le nom des fichiers dans ancien chemin est :
01nov06.xls
02nov06.xls
L'an prochain le nom des fichiers sera :
01nov07.xls
02nov07.xls
De plus, en février, le nombre de fichiers variera d'un année à l'autre.
La commande peut-elle être quelque chose comme ???
-----------------------------------------------------------------
Name StrPath & StrFich As StrPath2 & Left(StrFich, 2)
-----------------------------------------------------------------
Merci encore et bonne journée,
Céline

"MichDenis" a écrit dans le message de news:

Évidemment le classeur doit être fermé.

Name "c:ancien_cheminClasseur1.xls" As "c:Nouveau_CheminClasseur1.xls"



"Céline Brien" a écrit dans le message de
news:

Bonjour à tous,
Est-il possible de copier des classeurs vers un autre dossier en les
renommant, mais sans les ouvrir ?
Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me
semble que l'exécution serait plus rapide.
Vous trouverez ci-dessous des codes qui effectuent le travail, mais en
ouvrant les classeurs.
Merci de votre aide précieuse,
Céline
----------------------------------------
Sub ImporterNov()
'Chemin d'accès des fichiers du mois
StrPath = "R:ReportNov"
StrPath2 = "R:ReportPasTouche"
'Supprimer les fichiers dans le dossier PasTouche
Kill "R:ReportPasTouche*.xls"
'Ouverture d'Excel
Dim waExcel
Set waExcel = CreateObject("Excel.Application")
'Rendre Excel invisible
waExcel.Visible = False
'Rechercher les fichiers xls, les compter et les sauvegarer du premier au
dernier dans PasTouche
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.xls"
.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))
'Ouvrir le fichier xls
waExcel.Workbooks.Open .FoundFiles(i)
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en
utilisant les 2 caractères à droite et en mode partagé pour éviter des
erreurs.
waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , ,
,
, 2
End If
' waExcel.Workbooks.Close
waExcel.ActiveWorkbook.Close
Next i
End If
End With
'Fermeture d'Excel
waExcel.Application.Quit
End Sub





Avatar
Céline Brien
Salut à tous,
Salut Mich,
Je vais devoir garder mes codes qui ouvrent le fichier pour le renommer et
l'enregistrer dans un autre dossier car je viens tout juste de réaliser
qu'il faut aussi renommer l'onglet en passsant.
Merci encore de ton aide,
Céline

"Céline Brien" a écrit dans le message de
news:
Salut Mich,
Merci beaucoup pour ta réponse.
Le nom des fichiers dans ancien chemin est :
01nov06.xls
02nov06.xls
L'an prochain le nom des fichiers sera :
01nov07.xls
02nov07.xls
De plus, en février, le nombre de fichiers variera d'un année à l'autre.
La commande peut-elle être quelque chose comme ???
-----------------------------------------------------------------
Name StrPath & StrFich As StrPath2 & Left(StrFich, 2)
-----------------------------------------------------------------
Merci encore et bonne journée,
Céline

"MichDenis" a écrit dans le message de news:

Évidemment le classeur doit être fermé.

Name "c:ancien_cheminClasseur1.xls" As
"c:Nouveau_CheminClasseur1.xls"



"Céline Brien" a écrit dans le message de
news:

Bonjour à tous,
Est-il possible de copier des classeurs vers un autre dossier en les
renommant, mais sans les ouvrir ?
Bien que ces classeurs soient relativement petit, moins de 100 Ko, il me
semble que l'exécution serait plus rapide.
Vous trouverez ci-dessous des codes qui effectuent le travail, mais en
ouvrant les classeurs.
Merci de votre aide précieuse,
Céline
----------------------------------------
Sub ImporterNov()
'Chemin d'accès des fichiers du mois
StrPath = "R:ReportNov"
StrPath2 = "R:ReportPasTouche"
'Supprimer les fichiers dans le dossier PasTouche
Kill "R:ReportPasTouche*.xls"
'Ouverture d'Excel
Dim waExcel
Set waExcel = CreateObject("Excel.Application")
'Rendre Excel invisible
waExcel.Visible = False
'Rechercher les fichiers xls, les compter et les sauvegarer du premier au
dernier dans PasTouche
With waExcel.Application.FileSearch
.LookIn = StrPath
.SearchSubFolders = True
.Filename = "*.xls"
.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))
'Ouvrir le fichier xls
waExcel.Workbooks.Open .FoundFiles(i)
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en
utilisant les 2 caractères à droite et en mode partagé pour éviter des
erreurs.
waExcel.Workbooks(StrFich).SaveAs StrPath2 & Left(StrFich, 2), , , ,
,
, 2
End If
' waExcel.Workbooks.Close
waExcel.ActiveWorkbook.Close
Next i
End If
End With
'Fermeture d'Excel
waExcel.Application.Quit
End Sub