1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
|
Private Sub Commande3_Click()
Dim strTemp As String
Dim fso As Object
Dim intpos As Integer
Dim strchemin As String
Dim strNom As String
Dim InStr As Integer
strchemin = CurrentProject.Path & "\" & DOSSIER
'Ouvre la boite de dialogue
strTemp = OuvrirUnFichier(Me.hwnd, "Sélectionner le fichier word", 1)
'Si un fichier a été choisi alors vérifie qu'il est bien dans le répertoire Files de l'application
If strTemp <> "" Then
If InStr(1, strTemp, strchemin, vbTextCompare) <> 0 Then
'Alors valide
Me.CheminDoc = Right(strTemp, Len(strTemp) - Len(strchemin))
'sinon propose de le déplacer
Else
If MsgBox("Le fichier spécifié ne se trouve pas dans le répertoire de l'application. Voulez vous le déplacer ?", vbQuestion + vbYesNo, "Question") = vbYes Then
Set fso = CreateObject("Scripting.FileSystemObject")
'Vérifie que le repertoire existe, sinon le crée
If Not fso.FolderExists(strchemin) Then
fso.CreateFolder (strchemin)
MsgBox "Le répertoire Files n'existait pas, il a été créé avec succés", vbInformation
End If
'Déplace le fichier
strNom = recupNomFichier(strTemp)
fso.CopyFile strTemp, strchemin & strNom, True
'Stocke le nouveau chemin
Me.CheminDoc = strNom
'Ferme le FSO
Set fso = Nothing
End If
End If
End If
End Sub |
Partager