1
여기 내가 달성하려고하는 것입니다.VBA Outlook 프로그래밍
내 BlackBerry는 내 일기에 약속을 자동으로 추가합니다.
1) 접두사 "C."
2) 약속의 위치에 따라 약속을 분류 어떤 약속을 선택;
나는 자동으로 일정 항목의 생성에, 원하는 '수신 전화'와 '발신'= 카테고리 "전화", '부재중 전화'= 카테고리 "부재중 전화"
3) "C."을 제거 약속을 이름 바꾸기 접두사
4) 어떤 약속을 이동 "통화 기록"이라는 하위 캘린더의 "통화"카테고리
5) 수동 매크로 또는 미리 알림 구동 대신 새 약속이 추가되면 자동으로이 프로세스를 시작하고 싶습니다.
나는 웹상의 다른 곳에서 발견되는 아래의 프로세스를 수정하려고 노력했지만 .... 나를 위해 일하지는 않는다. 난 당신이 이런 식으로 뭔가를하고 싶은 생각
Private Sub Application_Reminder(ByVal Item As Object)
If Item.subject = "Process Calls" Then
' Define variables
Dim objCalendar As Outlook.folder
Dim objItems As Outlook.Items
Dim objAppt As Outlook.AppointmentItem
Dim strRestriction As String
Dim objFinalItems As Outlook.Items
Dim myolApp As Outlook.Application
' Set strRestriction to be only calls
strRestriction = "@SQL= (""urn:schemas:httpmail:subject"" LIKE '@Call.%' OR ""urn:schemas:httpmail:subject"" LIKE 'C.%' OR ""urn:schemas:httpmail:subject"" LIKE '@Call in%' OR ""urn:schemas:httpmail:subject"" LIKE '@Call%') AND ""urn:schemas-microsoft-com:office:office#Keywords"" 'Phone call'"
' Set the objCalendar and objItems items
Set objCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
Set objItems = objCalendar.Items
Set objFinalItems = objItems.Restrict(strRestriction)
Set myolApp = CreateObject("Outlook.Application")
For Each objAppt In objFinalItems
' Debugging
' Debug.Print objAppt.Start, objAppt.Subject, objAppt.Categories
' Assign the category to the appointments
If objAppt.Location = "Missed Call " Then
objAppt.Categories = "S. CALL MISSED."
ElseIf objAppt.Location = "Incoming Call " Then
objAppt.Categories = "S. CALL RECEIVED."
Else
objAppt.Categories = "S. CALL MADE."
End If
objAppt.Save
Next
' Rename Entry
Dim iItemsUpdated As Integer
Dim strTemp As String
iItemsUpdated = 0
For Each aItem In objCalendar.Items
If Mid(aItem.subject, 1, 2) = "C." Then
strTemp = Mid(aItem.subject, 4, Len(aItem.subject) - 4)
aItem.subject = strTemp
iItemsUpdated = iItemsUpdated + 1
End If
aItem.Save
Next aItem
MsgBox iItemsUpdated & " of " & objCalendar.Items.Count & " Meetings Updated"
End If
End Sub
Private Sub Application_Reminder(ByVal Item As Object)
If Item.subject = "Move Calls" Then
Public Sub MoveACallLog()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objAppt As Outlook.Items
Dim objFolder As Outlook.MAPIFolder
On Error Resume Next
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objAppt = objFolder.Items
' move to a calendar in an archive data file
Set CalFolder = GetFolderPath("\\[email protected]\Calendar\Call Log")
For i = objAppt.Count To 1 Step -1
If objAppt(i).Categories = "Calls" Then
objAppt(i).Move CalFolder
End If
Next i
Set objAppt = Nothing
Set objFolder = Nothing
Set objOL = Nothing
Set objNS = Nothing
End Sub
Function GetFolderPath(ByVal FolderPath As String) As Outlook.folder
Dim oFolder As Outlook.folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function
설명 맨 위 섹션의 코드는 무엇이며 맨 아래 코드는 무엇입니까? 제기 된 오류 또는 결과에 대해 알려주십시오 ... –