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

Le
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: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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichDenis
Le #4313931
Évidemment le classeur doit être fermé.

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



"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: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
Céline Brien
Le #4313781
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"
Évidemment le classeur doit être fermé.

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



"Céline Brien" 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





Céline Brien
Le #4313741
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" 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"
Évidemment le classeur doit être fermé.

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



"Céline Brien" 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









Publicité
Poster une réponse
Anonyme