'toutes vars déclarées public sont init dans userform
Private Sub CreatFichSaveAvecBatch(DatSvg$, DisqDestinSvg$)
' création du fichier.bat
NoF = FreeFile
Open PathNomDuFichierBat$ For Output As #NoF
Print #NoF, "@echo off"
Print #NoF, "break on"
Print #NoF, "mode con: COLS=120"
Print #NoF, "Rem ---------------------------------------- Nbr dossiers selon Disq/CleUsb ---"
Print #NoF, "SET NbrDeDossierSvg=" & Trim(NbrDeDossierSvgAvecOption)
Print #NoF, "SET LectDestin=" & LettreDuDisqDestin2P$
Print #NoF, "SET MsgDestin=" & FConvCaractWinEnDos(MsgDisqDestin$)
Print #NoF, "Rem ---------------------------------------- Vars pour tous ---"
Print #NoF, "SET NoDuDossier=0"
Print #NoF, "SET EspacesAff=" & Guillemet2$
Print #NoF, "SET PathSource=" & Guillemet2$
Print #NoF, "SET PathDestin=" & Guillemet2$
Print #NoF, "SET Options=" & Guillemet2$
Print #NoF, "SET Reponse=" & Guillemet2$
Print #NoF, "Rem ---------------------------------------- Vars des dossiers en ordre ---"
'boucle init tablo et écrit les SET PathSource(no) et destin
ReDim IfNoDossierOptSvg$(1 To NbrDeDossierSvgAvecOption)
ReDim IfNoDossierSource$(1 To NbrDeDossierSvgAvecOption)
ReDim IfNoDossierDestin$(1 To NbrDeDossierSvgAvecOption)
ReDim IfNoEspacesAffich$(1 To NbrDeDossierSvgAvecOption)
ReDim EchoNoDossierCopi$(1 To NbrDeDossierSvgAvecOption)
NbrSpaceMax = 0
For I = 1 To NbrDeDossierSvgAvecOption
L = Len(TabloSource(I)): If L > NbrSpaceMax Then NbrSpaceMax = L
Next
For I = 1 To NbrDeDossierSvgAvecOption
'ici n'arrive pas OptionSvgIgnorer$
If TabloOption(I) = OptionSvgDemander$ Then OptionSave$ = "D"
If TabloOption(I) = OptionSvgCopiRecentAuto$ Then OptionSave$ = "C"
If TabloOption(I) = OptionSvgRecopiToutAuto$ Then OptionSave$ = "R"
xPathSource$ = TabloSource(I): xPathSource$ = FConvCaractWinEnDos(xPathSource$)
xPathDestin$ = TabloDestin(I): xPathDestin$ = FConvCaractWinEnDos(xPathDestin$)
NbrEspace = NbrSpaceMax - Len(xPathSource$) 'space maxi nom dossier ci-dessus
IfNoEspacesAffich$(I) = "IF %NoDuDossier%==" & Trim(I) & " SET " & "EspacesAff=%EspacesAff" & Trim(I) & "%"
IfNoDossierOptSvg$(I) = "IF %NoDuDossier%==" & Trim(I) & " SET " & "OptionSave=%OptionSave" & Trim(I) & "%"
IfNoDossierSource$(I) = "IF %NoDuDossier%==" & Trim(I) & " SET " & "PathSource=%PathSource" & Trim(I) & "%"
IfNoDossierDestin$(I) = "IF %NoDuDossier%==" & Trim(I) & " SET " & "PathDestin=%PathDestin" & Trim(I) & "%"
EchoNoDossierCopi$(I) = "echo source %PathSource" & Trim(I) & "%" & Space(NbrEspace) & " destin " & "%PathDestin" & Trim(I) & "%"
Print #NoF, "SET EspacesAff" & Trim(I) & "=" & Space(NbrEspace)
Print #NoF, "SET OptionSave" & Trim(I) & "=" & OptionSave$
Print #NoF, "SET PathSource" & Trim(I) & "=" & LettreDuDisqSource2P$ & Guillemet1$ & xPathSource$ & Guillemet1$
Print #NoF, "SET PathDestin" & Trim(I) & "=" & LettreDuDisqDestin2P$ & Guillemet1$ & xPathDestin$ & Guillemet1$
Next
Print #NoF, "Rem --------------------------------------- DEPART TEST LECTEURS ---"
Print #NoF, "IF exist %LectDestin% GOTO GoDisqueOk"
Print #NoF, "echo."
Print #NoF, "echo Lecteur %LectDestin% de destination non connect‚ !?"
Print #NoF, "GoTo Quitter"
Print #NoF, ""
Print #NoF, ":GoDisqueOk"
Print #NoF, "echo COPIER au choix les Dossiers Source " & NomDuDisqSource$ & " " & LettreDuDisqSource2P$ & "\ destination %MsgDestin%"
Print #NoF, "echo ------ ASTUCE POUR QUITTER EN URGENCE Taper Ctrl+C"
'n'affiche plus
'For I = 1 To NbrDeDossierSvgAvecOption: Print #NoF, EchoNoDossierCopi$(I): Next
Print #NoF, "echo."
Print #NoF, "rem --------------------------------------- Boucle Dossiers ---"
Print #NoF, "SET NoDuDossier=0"
Print #NoF, ":BoucleDossierSuivant"
Print #NoF, "SET PathSource=" & Guillemet2$
Print #NoF, "SET PathDestin=" & Guillemet2$
Print #NoF, "IF %NoDuDossier%==%NbrDeDossierSvg% GOTO Quitter"
Print #NoF, "SET /a NoDuDossier=%NoDuDossier%+1"
For I = 1 To NbrDeDossierSvgAvecOption
Print #NoF, IfNoEspacesAffich$(I)
Print #NoF, IfNoDossierOptSvg$(I)
Print #NoF, IfNoDossierSource$(I)
Print #NoF, IfNoDossierDestin$(I)
Next
Print #NoF, ""
Print #NoF, "Rem ----------------- si le rep existe: supprimer et copier ou copier les fich.récents"
Print #NoF, "IF exist %PathDestin% goto SauvegardeRepExistant"
Print #NoF, "Rem ----------------- sinon demande pour créer et copier le dossier !?"
Print #NoF, "echo source %PathSource% %EspacesAff%destin %PathDestin% %EspacesAff% qui N'EXISTE PAS ..."
'impose création si Copier ou Remplacer sinon demander ?
Print #NoF, "SET Reponse=C"
Print #NoF, "IF /i %OptionSave%==D SET Reponse=" & Guillemet2$
Print #NoF, "IF /i %OptionSave%==D SET /P Reponse=Voulez-vous le (C)r‚er+(C)opier le contenu (Q)uitte (enter)suivant ? "
Print #NoF, "echo."
Print #NoF, "IF /i %Reponse%==Q GOTO Quitter"
Print #NoF, "IF /i %Reponse%==C GOTO CreatDir"
Print #NoF, "GoTo BoucleDossierSuivant"
Print #NoF, ""
Print #NoF, "Rem ------------------"
Print #NoF, ":SauvegardeRepExistant"
Print #NoF, "echo source %PathSource% %EspacesAff%destin %PathDestin% %EspacesAff% qui existe d‚j… ..."
Print #NoF, "SET Reponse=%OptionSave%"
Print #NoF, "IF /i %OptionSave%==D SET Reponse=" & Guillemet2$
Print #NoF, "IF /i %OptionSave%==D SET /P Reponse=(C)opier les fich.r‚cents (R)emplacer tout (Q)uitte (enter)suivant ? "
Print #NoF, "echo."
Print #NoF, "IF /i %Reponse%==Q GOTO Quitter"
Print #NoF, "IF /i %Reponse%==C GOTO CopierRecents"
Print #NoF, "IF /i %Reponse%==R GOTO RemplacerTout"
Print #NoF, "GoTo BoucleDossierSuivant"
Print #NoF, ""
Print #NoF, ":CopierRecents"
If DatSvg$ = "" Then
Print #NoF, "SET Options=" & OptionXCOPY1$
Else
DatXcopy$ = Format(DatSvg$, "mm-dd-yyyy")
Print #NoF, "SET Options=/D:" & DatXcopy$ & OptionXCOPY2$
End If
Print #NoF, "XCOPY %PathSource% %PathDestin% %Options%"
Print #NoF, "GoTo MsgFinSaveDossierSuivant"
Print #NoF, ""
Print #NoF, "Rem ---------- demande supp rep.existant!? si ok suppr/recree/copie tout!? sinon suite dossier suivant"
'supp / Q sans confirmation
Print #NoF, ":RemplacerTout"
Print #NoF, "SET Options=/S /Q"
Print #NoF, "IF /i %OptionSave%==D SET Options=/S"
Print #NoF, "IF /i %OptionSave%==D echo Confirmez le remplacement complet de %PathDestin% !"
Print #NoF, "RMDIR %Options% %PathDestin%"
Print #NoF, "IF exist %PathDestin% goto PasseMsgFinSaveDossierSuivant"
Print #NoF, ""
Print #NoF, "Rem ---------- suite ci-dessus et arrivée pour création !? ---"
Print #NoF, ":CreatDir"
Print #NoF, "MKDIR %PathDestin%"
Print #NoF, "IF not exist %PathDestin% goto ErreurRep"
Print #NoF, "SET Options=/E /I /H"
Print #NoF, "XCOPY %PathSource% %PathDestin% %Options%"
Print #NoF, "GoTo MsgFinSaveDossierSuivant"
Print #NoF, ""
Print #NoF, "Rem ---------- message fin sauvegarde -------------------"
Print #NoF, ":MsgFinSaveDossierSuivant"
Print #NoF, "echo."
Print #NoF, "echo.... Sauvegarde %PathSource% termin‚e !"
Print #NoF, "echo."
Print #NoF, ":PasseMsgFinSaveDossierSuivant"
Print #NoF, "echo."
Print #NoF, "GoTo BoucleDossierSuivant"
Print #NoF, ""
Print #NoF, "Rem ---------- erreur a la creation du rep ---------------"
Print #NoF, ":ErreurRep"
Print #NoF, "echo."
Print #NoF, "echo Erreur lors de la cr‚ation du r‚pertoire %PathDestin%"
Print #NoF, "echo."
Print #NoF, "GoTo BoucleDossierSuivant"
Print #NoF, ""
Print #NoF, "Rem ---------- quitte programme --------------------------"
Print #NoF, ":Quitter"
Print #NoF, "echo."
Print #NoF, "echo................"
Print #NoF, "echo Fin sauvegarde. Appuyez sur une touche pour quitter !"
Print #NoF, "pause > nul"
Print #NoF, "del " & PathNomDuFichierBat$
Close #NoF
'! exécution !
Shell PathNomDuFichierBat$, vbMaximizedFocus
'save nom du disque et date de sauvegarde
Sheets(NomDeLaFeuilMemo$).Select
Lig = 2
While Sheets(NomDeLaFeuilMemo$).Cells(Lig, 1) > "": Lig = Lig + 1: Wend
Sheets(NomDeLaFeuilMemo$).Cells(Lig, 1) = Now
Sheets(NomDeLaFeuilMemo$).Cells(Lig, 2) = DatSvg$
Sheets(NomDeLaFeuilMemo$).Cells(Lig, 3) = DisqDestinSvg$
End Sub
Private Function FConvCaractWinEnDos(M$) As String
MM$ = M$
For I = 1 To 11 'é(‚) è(Š) ê(ˆ) ë(‰) à(…) â(ƒ) ä(„) ù(—) û(–) ü(š) ç(‡)
CarWin$ = Choose(I, "é", "è", "ê", "ë", "à", "â", "ä", "ù", "û", "ü", "ç")
CarDos$ = Choose(I, "‚", "Š", "ˆ", "‰", "…", "ƒ", "„", "—", "–", "š", "‡")
MM$ = Replace(MM$, CarWin$, CarDos$)
Next
FConvCaractWinEnDos = MM$
End Function
Private Function FConvCaractDosEnWin(M$) As String
MM$ = M$
For I = 1 To 11 'é(‚) è(Š) ê(ˆ) ë(‰) à(…) â(ƒ) ä(„) ù(—) û(–) ü(š) ç(‡)
CarDos$ = Choose(I, "‚", "Š", "ˆ", "‰", "…", "ƒ", "„", "—", "–", "š", "‡")
CarWin$ = Choose(I, "é", "è", "ê", "ë", "à", "â", "ä", "ù", "û", "ü", "ç")
MM$ = Replace(MM$, CarDos$, CarWin$)
Next
FConvCaractDosEnWin = MM$
End Function
c'est juste américain !
