Sub OO()
'cocher la librairie Microsoft Scripting Runtime
Dim oFso As Scripting.FileSystemObject
Dim oDrive As Scripting.Drive
Dim oFl As Scripting.File
Dim CheminFichier As String
CheminFichier = "C:\toto.xls" 'chemin à adapter
Set oFso = New Scripting.FileSystemObject
If oFso.FileExists(CheminFichier) Then
Set oFl = oFso.GetFile(CheminFichier)
Else
MsgBox "Dossier non trouvé": Exit Sub
End If
For Each oDrive In oFso.Drives
'si c'est un disque dur et que sa lettre est G (à adapter)
If oDrive.DriveType = Fixed And oDrive.DriveLetter = "G" Then _
oFl.Copy "G:\", True: Exit Sub
Next oDrive
End Sub
...Vois si cela peut t'aider...
Option Explicit
Sub OO_non_OK()
'cocher la librairie Microsoft Scripting Runtime
Dim oFso As Scripting.FileSystemObject
Dim oDrive As Scripting.Drive
Dim oFl As Scripting.File
Dim CheminFichierA As String
Dim CheminfichierB As String
CheminFichierA = "C:\Users\00\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB" 'chemin à adapter
CheminfichierB = "C:\Users\00\Documents\009 Ordinateur\MACROS PERSONNELLES" 'chemin à adapter
Set oFso = New Scripting.FileSystemObject
If oFso.FileExists(CheminFichierA) Then
Set oFl = oFso.GetFile(CheminFichierA)
Else
MsgBox "Dossier non trouvé": Exit Sub
End If
For Each oDrive In oFso.Drives
oFl.Copy CheminfichierB, True: Exit Sub '============================>>Blocage sur cette ligne
Next oDrive
End Sub
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
(ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
Sub Sauve_ce_fichier_sur_le_C_Temp()
On Error GoTo suite
NOMW = ActiveWorkbook.Name
ThisWorkbook.Save
Suite2:
ActiveWorkbook.SaveCopyAs Filename:="C:\Temp\Sauvegarde\Programme\" & NOMW ', FileFormat:= _
xlOpenXMLWorkbookMacroEnabled , CreateBackup:=False
End
suite:
CreationDossier ("C:\Temp\Sauvegarde\Programme")
GoTo Suite2
End Sub
Sub CreationDossier(sNomRep As String)
'ChDrive "D"
SHCreateDirectoryEx 0&, sNomRep, 0&
End Sub
For Each oDrive In oFso.Drives
'si c'est un disque dur et que sa lettre est G (à adapter)
If oDrive.DriveType = Fixed And oDrive.DriveLetter = "G" Then _
oFl.Copy "G:\", True: Exit Sub
Next oDrive
If oDrive.DriveType = Fixed And oDrive.DriveLetter = "G" Then
Sub OO2()
'cocher la librairie Microsoft Scripting Runtime
Dim oFso As Scripting.FileSystemObject
Dim CheminFichierA As String
Dim CheminfichierB As String
CheminFichierA = "C:\Users\00\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB"
CheminfichierB = "C:\Users\00\Documents\009 Ordinateur\MACROS PERSONNELLES" 'placer le chemin complet
Set oFso = New Scripting.FileSystemObject
If oFso.FileExists(CheminFichierA) Then
oFso.CopyFile CheminFichierA, CheminfichierB, True
Else
MsgBox "Fichier non trouvé"
End If
End Sub
00:...
Pour faire mes sauvegardes, j’utilise un logiciel gratuit, lequel passe en revue les éventuelles modifications apportées à l’ensemble de mes fichiers préalablement choisis (images, .doc , .docx, .xls, .xlsm…).
Cependant, les modifications du fichier « PERSONAL.XLSB » demeurent exclues du champ d’application.
Sur une de mes applications, j'ai ce code pour créer une copie sur C:\Temp\Sauvegarde.
Peux-tu indiquer le nom de ce logiciel et son URL, stp? (cela pourrait peut-être intéresser certains d'entre nous)
je parie sur Cobian BackupPerdu ou gagné ?
Dim oFso As Scripting.FileSystemObject
Dim oFso as Object
Set oFso = New Scripting.FileSystemObject
Set oFso = CreateObject("Scripting.FileSystemObject")
@ Staple1600,
Je n'ai pas testé celui que tu évoques et ne peux dire lequel des deux est le meilleur.
A bientôt