اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

تصدير بعض الأنشطة عن طريق الكود من مايكروسوفت بروجكت الي الاوتلوك


الردود الموصى بها

 

لتصدير عدد من الانشطة المختار

اختار الانشطة باي طريقة تناسبك ، ثم شغل الكود التالي

 للتصدير الي المواعيد كدعوة لاجتماع

Option Explicit

Public myOLApp As Object
Sub Export_Selection_To_OL_Appointments()
Dim myTask As Task
Dim myItem As Object
    
  On Error Resume Next
  Set myOLApp = CreateObject("Outlook.Application")
  
  For Each myTask In ActiveSelection.Tasks
    Set myItem = myOLApp.CreateItem(1)
    With myItem
      .Start = myTask.Start
      .End = myTask.Finish
      .Subject = myTask.Name & " (Project Task)"
      .Categories = myTask.Project
      .Body = myTask.Notes
      .Save
    End With
  Next myTask

End Sub

 

للتصدير الي المهام

Sub Export_Selection_To_OL_Tasks()
Dim myTask As Task
Dim myItem As Object
   
  On Error Resume Next
  Set myOLApp = CreateObject("Outlook.Application")
  
  For Each myTask In ActiveSelection.Tasks
    Set myItem = myOLApp.CreateItem(3)
    With myItem
      .StartDate = myTask.Start
      .DueDate = myTask.Finish
      .Subject = myTask.Name & " (Project Task)"
      .Body = myTask.Notes
      .Categories = myTask.Project
      .Save
    End With
  Next myTask

 

و للتصدير الي الملاحظات

Sub Export_Selection_To_OL_Notes()
Dim myTask As Task
Dim myItem As Object
Dim myNotesText As String
    
  On Error Resume Next
  Set myOLApp = CreateObject("Outlook.Application")
  
  For Each myTask In ActiveSelection.Tasks
    Set myItem = myOLApp.CreateItem(5)
    myNotesText = myTask.Name & " (Project Task)" & Chr(13) & _
                  "   Name:      " & myTask.Name & Chr(13) & _
                  "   Start:     " & myTask.Start & Chr(13) & _
                  "   End:       " & myTask.Finish & Chr(13) & _
                  "   Note:      " & myTask.Notes
    With myItem
      .Categories = myTask.Project
      .Body = myNotesText
      .Save
    End With
    myNotesText = ""
  Next myTask

End Sub

 

و لتكوين قائمة جديد تعطيك بهض الخيارات الاضافية

SNAG-0002.jpg.a1108908a5841bd7f4cecc247935f3ca.jpg

SNAG-0003.jpg.4f35490e1b7402e51f3110522a042328.jpg

 

يتم اضافة و تشغيل لكود التالي

Option Explicit
 
Sub CreateMenus()

Dim cbrMain As CommandBar
Dim ctlMain As CommandBarControl

Dim ctlOLExport1 As CommandBarControl
Dim ctlOLExport2 As CommandBarControl
Dim ctlOLExport3 As CommandBarControl
  
  Set cbrMain = Application.CommandBars.ActiveMenuBar
  Set ctlMain = cbrMain.Controls.Add(Type:=msoControlPopup, Temporary:=True)
  ctlMain.Caption = "Export to Outlook"
  
  Set ctlOLExport1 = ctlMain.CommandBar.Controls.Add(Type:=msoControlButton)
  With ctlOLExport1
    .Caption = "Selection to Outlook tasks"
    .OnAction = "Macro """ & "Export_Selection_To_OL_Tasks"""
  End With

  Set ctlOLExport2 = ctlMain.CommandBar.Controls.Add(Type:=msoControlButton)
  With ctlOLExport2
    .Caption = "Selection to Outlook appointments"
    .OnAction = "Macro """ & "Export_Selection_To_OL_Appointments"""
  End With
  
  Set ctlOLExport3 = ctlMain.CommandBar.Controls.Add(Type:=msoControlButton)
  With ctlOLExport3
    .Caption = "Selection to Outlook notes"
    .OnAction = "Macro """ & "Export_Selection_To_OL_Notes"""
  End With
  
End Sub

مرفق المثالexport_project_tasks_to_outlook_late_bound.rar

  • Thanks 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • اضف...

Important Information