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 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
|
' *********** nouveau code pour avoir les raccourcis
' ***************************** 2014-01-19
BrowseForFolder = BrowseFolderExplorer("Classement de courriel(s)", msoFileDialogViewDetails, SDossier(0, 0) & "\")
stNumProj = "" ' no de projet
stNumServ = "" ' no service
If BrowseForFolder = "" Then Exit Function
FolderName = BrowseForFolder '& "\"
'Recherche le nom du dossier afin de repérer le no de service et de projet
' Modifications pour nouveaux projets 2012-02-29 LP
If UCase(Mid(FolderName, (InStr(FolderName, "\P0") + 1), 2)) = "P0" Then ' ancien no
stNumProj = UCase(Mid(FolderName, (InStr(FolderName, "\P0") + 1), 7))
stNumServ = Mid(FolderName, (InStr(FolderName, "\P0") + 1) - 4, 3) ' no service
ElseIf UCase(Mid(FolderName, (InStr(FolderName, "\B-0") + 1), 3)) = "B-0" Then
stNumProj = UCase(Mid(FolderName, (InStr(FolderName, "\B-0") + 1), 9))
stNumServ = Mid(FolderName, (InStr(FolderName, "\B-0") + 1) - 4, 3) ' no service
ElseIf UCase(Mid(FolderName, (InStr(FolderName, "\P-0") + 1), 3)) = "P-0" Then
stNumProj = UCase(Mid(FolderName, (InStr(FolderName, "\P-0") + 1), 9))
stNumServ = Mid(FolderName, (InStr(FolderName, "\P-0") + 1) - 4, 3) ' no service
ElseIf UCase(Mid(FolderName, (InStr(FolderName, "\GC-0") + 1), 4)) = "GC-0" Then
stNumProj = UCase(Mid(FolderName, (InStr(FolderName, "\GC-0") + 1), 9))
stNumServ = Mid(FolderName, (InStr(FolderName, "\GC-0") + 1) - 4, 3) ' no service
ElseIf UCase(Mid(FolderName, (InStr(FolderName, "\RG-0") + 1), 4)) = "RG-0" Then
stNumProj = UCase(Mid(FolderName, (InStr(FolderName, "\RG-0") + 1), 9))
stNumServ = Mid(FolderName, (InStr(FolderName, "\RG-0") + 1) - 4, 3) ' no service
ElseIf UCase(Mid(FolderName, (InStr(FolderName, "\Offre") + 1), 5)) = "OFFRE" Then ' OFFRE"
stNumProj = "OFS" 'UCase(Mid(FolderName, (InStr(FolderName, "\Offre") + 1), 5))
stNumServ = Mid(FolderName, (InStr(FolderName, "\Offre") + 1) - 4, 3) ' "des Offres de service" '
ElseIf Dir(FolderName, vbDirectory) = "Desktop" Then
stNumProj = UCase(Mid(FolderName, (InStr(FolderName, "\" & Dir(FolderName, vbDirectory)) + 1), 7)) ' UCase(Mid(FolderName, (InStr(FolderName, "\P0") + 1), 7))
stNumServ = UCase(Mid(FolderName, (InStr(FolderName, "\" & Dir(FolderName, vbDirectory)) + 1) - Len(Dir(FolderName, vbDirectory)), Len(Dir(FolderName, vbDirectory)) - 1)) 'UCase(Mid(FolderName, 1, Len(stNumProj) + 1))
' stNumServ = UCase(Mid(FolderName, (InStr(FolderName, "\" & Dir(FolderName, vbDirectory)) + 1) - 4, 3)) 'UCase(Mid(FolderName, 1, Len(stNumProj) + 1))
Else ' vérifier si ce n'est pas un projet
stNumProj = UCase(Mid(FolderName, (InStr(FolderName, "\" & Dir(FolderName, vbDirectory)) + 1), 7)) ' UCase(Mid(FolderName, (InStr(FolderName, "\P0") + 1), 7))
stNumServ = UCase(Mid(FolderName, (InStr(FolderName, "\" & Dir(FolderName, vbDirectory)) + 1) - 4, 3)) ' no service
End If
' stNumProj = InputBox("S.V.P." & vbCrLf & vbCrLf & " Veuillez valider le numéro de projet.", "Numéro de projet", stNumProj)
If stNumProj = "OFS" Then ' offre de services
stNumProj = InputBox("Le courriel sera classé dans le dossier : " & vbCrLf & Space(10) & "des Offres de service" & vbCrLf & vbCrLf & _
vbCrLf & "Veuillez valider le nom du sous-dossier : ", "Définir le nom du courriel", stNumProj)
ElseIf Left(stNumServ, 3) = Left(stNumProj, 3) Then ' avec no projet
stNumProj = InputBox("Le courriel sera classé dans le dossier : " & stNumProj & vbCrLf & vbCrLf & _
vbCrLf & "Veuillez valider le nom du sous-dossier : ", "Définir le nom du courriel", stNumProj)
ElseIf Dir(FolderName, vbDirectory) = "Desktop" Then
stNumProj = InputBox("Le courriel sera classé dans le dossier sur le bureau." & vbCrLf & vbCrLf & _
vbCrLf & "Veuillez valider le nom du sous-dossier : ", "Définir le nom du courriel", stNumProj)
Else ' sans nos de projet ou pas dans les offres de services
stNumProj = InputBox("Le courriel sera classé dans le service : " & stNumServ & vbCrLf & vbCrLf & _
vbCrLf & "Veuillez valider le numéro de projet : ", "Définir le nom du courriel", stNumProj)
End If
If stNumProj = "" Then ' annuler la commande de classement
Exit Function
End If
...
If Dir(FolderName, vbDirectory) = "Desktop" Then
FileName = FolderName & "\" & SetFileName(EMAIL, FolderName, stNumServ, stInitiales, TYPE_REVISION, DeQui, stNom)
Else
FileName = FolderName & "\" & SetFileName(EMAIL, FolderName, stNumServ & "-" & stNumProj, stInitiales, TYPE_REVISION, DeQui, stNom)
End If |
Partager