strFolder = ThisWorkbook.Path & "\"
Dim wbk As Workbook
Dim wbkName As String
Dim fso As Object
Dim Chemin$, Client$, Fichier$
Chemin = "D:\TDR"
Client = Txt1.Value
Date = Txt2.Value
Fichier = Client & ".xls"
If Txt1 = "" Or Txt2 = "" Then
MsgBox "Client et date Obligatoire"
Exit Sub
End If
For Each wbk In Workbooks
If wbk.Name <> ThisWorkbook.Name Then
wbk.Close
End If
Next wbk
wbkName = strFolder & Client & Date & ".xls"
If Dir(wbkName) <> "" Then
MsgBox "le classeur " & wbkName & "existe déjà", vbExclamation
Exit Sub
End If
Set wbk = ThisWorkbook
If Dir(strFolder & Client & Date, vbDirectory) = "" Then
Set fso = CreateObject("Scripting.FileSystemObject")
fso.createfolder (strFolder & Client)
End If
ChDir strFolder
wbkName = strFolder & Client & Date & ".xls"
ActiveWorkbook.SaveAs strFolder & Client & "\" & Fichier
Unload Me