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
| Private Sub CommandButton3_Click()
Const Dossiers_Publics = 18
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set colFolder = objNamespace.GetDefaultFolder(Dossiers_Publics).Folders("Jobs (en Cours) Dossiers")
intCount = colFolder.items.Count
For i = 2 To intCount
If (colFolder.items(i).Attachments.Count > 0) And ActiveWorkbook.Sheets("RAPPORT").Range("D3") Then
'Worksheets("TABLEMAT").Cells(i, 1).Value = colFolder.items(i).Subject
' Set objDistList = colItems.Item(i)
' Wscript.Echo objDistList.DLName
' For j = 1 To objDistList.MemberCount
'Wscript.Echo objDistList.GetMember(j).Name & " -- " & _
' objDistList.GetMember(j).Address
' Else
' Wscript.Echo colFolderItems.Item(i)
End If
' Définir le chemin d'accès au fichier ainsi que son nom
sPath = colFolder & "\"
sFic = ActiveWorkbook.Sheets("RAPPORT").Range("D3") & "*" & ".xlsx"
' Copier la feuille du classeur correspondant
Workbooks.Open sPath & sFic
ActiveWorkbook.Sheets("TABLEMAT").Cells.Copy Destination:=ThisWorkbook.Sheets("TABLEMAT").Range("A1")
Application.CutCopyMode = False
ActiveWorkbook.Close
' Fermer l'userform
Unload Me
Next
End Sub |
Partager