Aide pour renommer un fichier en fonction de sa date

Le 01/05/2014 à 17:32

Bonjour,

J'ai un soucis dans le que je mettrai en bas. En tout se passe bien jusqu'à la macro rename_affaire. Les macro nom1 et nom2 refuse de s'executer. Pour ceux qui voudrait bien m'aider, le but de ces macros, c'est d'ajouter la date d'extration au nom des fichiers vu que c'est des fichiers qu'on va extraitre quotidiennement. Mon but en gros, c'est de renommer les deux fichiers ouverts enfonction de la date d'extraction puis les fermer après. Quelqu'un pourra m'aider. Merci beaucoup d'avance.

Option Explicit

Private Declare Function URLDownloadToFile _

Lib "urlmon" Alias "URLDownloadToFileA" _

(ByVal pCaller As Long, ByVal szURL As String, _

ByVal szFileName As String, ByVal dwReserved As Long, _

ByVal lpfnCB As Long) As Long

Private Const ERROR_SUCCESS As Long = 0

Public Function DownloadFile(ByVal sURL As String, _

ByVal sLocalFile As String) As Boolean

Dim lngRetVal As Long

DownloadFile = URLDownloadToFile(0&, sURL, _

sLocalFile, 0&, 0&) = ERROR_SUCCESS

End Function

Sub telecharger_zip()

'------------------------fichier pour les affaires -------------------

DownloadFile _

"

", "Q:\TEMP\affaire_os\affaire\04_npdc_affaire.zip"

DownloadFile _

"

", "Q:\TEMP\affaire_os\affaire\05_normadie_affaire.zip"

DownloadFile _

"

", "Q:\TEMP\affaire_os\affaire\06_picardie_affaire.zip"

'------------------------fichier pour les OS -------------------

DownloadFile _

"

", "Q:\TEMP\affaire_os\os\04_npdc_os.zip"

DownloadFile _

"

", "Q:\TEMP\affaire_os\os\05_normadie_os.zip"

DownloadFile _

"

", "Q:\TEMP\affaire_os\os\06_picardie_os.zip"

End Sub

'------------------------dezip des affaires -------------------

Sub dezip()

Call UnZip("Q:\TEMP\affaire_os\affaire", "dezip", "Q:\TEMP\affaire_os\affaire\04_npdc_affaire.zip")

Call UnZip("Q:\TEMP\affaire_os\affaire", "dezip", "Q:\TEMP\affaire_os\affaire\04_npdc_affaire.zip")

Call UnZip("Q:\TEMP\affaire_os\affaire", "dezip", "Q:\TEMP\affaire_os\affaire\05_normadie_affaire.zip")

Call UnZip("Q:\TEMP\affaire_os\affaire", "dezip", "Q:\TEMP\affaire_os\affaire\06_picardie_affaire.zip")

'------------------------dezip des OS -------------------

Call UnZip("Q:\TEMP\affaire_os\os", "dezip", "Q:\TEMP\affaire_os\os\04_npdc_os.zip")

Call UnZip("Q:\TEMP\affaire_os\os", "dezip", "Q:\TEMP\affaire_os\os\04_npdc_os.zip")

Call UnZip("Q:\TEMP\affaire_os\os", "dezip", "Q:\TEMP\affaire_os\os\05_normadie_os.zip")

Call UnZip("Q:\TEMP\affaire_os\os", "dezip", "Q:\TEMP\affaire_os\os\06_picardie_os.zip")

End Sub

Sub UnZip(strTargetPath As String, Dossier As String, Fname As Variant)

Dim oApp As Object

Dim FileNameFolder As Variant

If Right(strTargetPath, 1) <> Application.PathSeparator Then

strTargetPath = strTargetPath & Application.PathSeparator

End If

If Not (RepertoireExiste(strTargetPath & Dossier)) Then

MkDir (strTargetPath & Dossier)

Else

FileNameFolder = strTargetPath & Dossier

Set oApp = CreateObject("Shell.Application")

oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items

End If

End Sub

Function RepertoireExiste(Chemin As String) As Boolean

On Error Resume Next

RepertoireExiste = GetAttr(Chemin) And vbDirectory

End Function

' Cette macro à pour but de nomme la premiere feuille le numéro de la semaine

Sub feuille_date()

Dim NumSem As Byte

NumSem = DatePart("ww", Date, 2, 2)

Sheets(1).Name = "Semaine_" & NumSem

End Sub

' Enregistrement de la feuille sous récap afin d'effectuer nos concatenations

Sub Macro_enregistrement()

ChDir "Q:\TEMP\affaire_os\affaire\dezip"

ActiveWorkbook.SaveAs Filename:= _

"Q:\TEMP\affaire_os\affaire\dezip\Recap.xls", FileFormat:= _

xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

ChDir "Q:\TEMP\affaire_os\os\dezip"

ActiveWorkbook.SaveAs Filename:= _

"Q:\TEMP\affaire_os\os\dezip\Recap.xls", FileFormat:= _

xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

' La compilation

Sub Compilation()

Dim Temp As String

Dim Ligne As Long

Temp = Dir(ActiveWorkbook.Path & "\*.xls")

Application.DisplayAlerts = False

Do While Temp <> ""

If Temp <> "Recap.xls" Then

Workbooks.Open ActiveWorkbook.Path & "\" & Temp

Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy

Workbooks("Recap.xls").Sheets(1).Activate

Ligne = Sheets(1).Range("A65536").End(xlUp).Row + 1

Range("A" & CStr(Ligne)).Select

ActiveSheet.Paste

Workbooks(Temp).Close

End If

Temp = Dir

Loop

Range("A1").Select

Application.DisplayAlerts = True

End Sub

Sub compil_os()

ChDir "Q:\TEMP\affaire_os\os\dezip"

ActiveWorkbook.SaveAs Filename:= _

"Q:\TEMP\affaire_os\os\dezip\recap_os.xls", FileFormat:=xlExcel8, _

Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _

CreateBackup:=False

End Sub

' Ouverture recap affaire

Sub ouverture_recap_affaire()

ChDir "Q:\TEMP\affaire_os\affaire\dezip"

Workbooks.Open Filename:="Q:\TEMP\affaire_os\affaire\dezip\Recap.xls"

End Sub

Sub Compilation2()

Dim Temp As String

Dim Ligne As Long

Temp = Dir(ActiveWorkbook.Path & "\*.xls")

Application.DisplayAlerts = False

Do While Temp <> ""

If Temp <> "Recap.xls" Then

Workbooks.Open ActiveWorkbook.Path & "\" & Temp

Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy

Workbooks("Recap.xls").Sheets(1).Activate

Ligne = Sheets(1).Range("A65536").End(xlUp).Row + 1

Range("A" & CStr(Ligne)).Select

ActiveSheet.Paste

Workbooks(Temp).Close

End If

Temp = Dir

Loop

Range("A1").Select

Application.DisplayAlerts = True

End Sub

Sub rename_affaire()

ChDir "Q:\TEMP\affaire_os\affaire\dezip"

ActiveWorkbook.SaveAs Filename:= _

"Q:\TEMP\affaire_os\affaire\dezip\recap_affaire.xls", FileFormat:=xlExcel8, _

Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _

CreateBackup:=False

End Sub

Sub nom1()

Dim Chemin As String, Fichier As String

Chemin = "Q:\TEMP\affaire_os\affaire\dezip\"

'Ajoute la date du jour et l'heure dans le nom du fichier

Fichier = "recap_affaire" & Format(Date, "ddmmyyyy") & ".xls"

ActiveWorkbook.SaveCopyAs Chemin & Fichier

End Sub

Sub nom2()

Dim Chemin2 As String, Fichier2 As String

Chemin2 = "Q:\TEMP\affaire_os\os\dezip\"

'Ajoute la date du jour et l'heure dans le nom du fichier

Workbooks("recap_os.xls").Activate

Fichier2 = "recap_os" & Format(Date, "ddmmyyyy") & ".xls"

ActiveWorkbook.SaveCopyAs Chemin2 & Fichier2

Application.DisplayAlerts = False

Application.Quit

End Sub

Sub main()

Application.Run ("telecharger_zip")

Application.Run ("dezip")

Application.Run ("feuille_date")

Application.Run ("Macro_enregistrement")

Application.Run ("Compilation")

Application.Run ("compil_os")

Application.Run ("ouverture_recap_affaire")

Application.Run ("Compilation2")

Application.Run ("rename_affaire")

Application.Run ("nom1")

Application.Run ("nom2")

End Sub

Le 01/05/2014 à 21:26

Salut et bienvenue sur le Forum,

Le code que tu nous présentes fout un peu la trouille et on aurait envie de passer. Mais bon, il serait quand même intéressant de voir ton fichier qui n’est pas passé (tu as écrit : 'J'ai un soucis dans le que je mettrai en bas.', donc je présume que tu as voulu dire dans le fichier que je mettrai en bas).

Cordialement.

Pour joindre un fichier ……

joindre un fichier
Rechercher des sujets similaires à "aide renommer fichier fonction date"