2016-03-29 18 views
0

Şu anda Outlook'taki bir VBA kodu üzerinde çalışmak için ana posta kutusundan, ikincil posta kutusundan veya arşiv posta kutusundan (PST) yanlışlıkla taşınan bir klasör bulmanıza yardımcı olacak bir makro olarak çalışıyorum.Outlook'ta Hatalı Bir Klasör Bul

Şu anda koşulan kod, çevrimdışı görünümde geçiş yapacak, klasör adını (joker arama uygulandığında kısmi olabilir) soracaktır, adın ilk örneğini döndürür ve klasöre götürür ve son olarak Outlook'u geri yükler. çevrimiçi moda.

Aramanın tüm örneklerini yinelemesini (örneğin, birincil posta kutusu ve arşivler içindeki "Nisan" adıyla birden çok klasör) alma işlemini anlamaya çalışıyorum. Bilinen bir sayaçla döngü yapana kadar yapılması gerekebileceğini biliyorum, ancak nasıl uygulanacağından emin değilim.

Sub ToggleWorkOfflineMode() 
Dim OutApp As Object 
Set OutApp = CreateObject("Outlook.Application") 
If Not OutApp.Session.Offline = True Then 
If MsgBox("Do you want to enable Work Offline Status?", vbQuestion Or vbYesNo) = vbYes Then 
OutApp.GetNamespace("MAPI").Folders.GetFirst.GetExplorer.CommandBars.FindControl(, 5613).Execute 
Else 
MsgBox "Status Not Changed.", vbInformation 
End If 
Else 
If MsgBox("Do you Want to disable Work Offline Status?", vbQuestion Or vbYesNo) = vbNo Then 
MsgBox "Working offline", vbInformation 
Else 
OutApp.GetNamespace("MAPI").Folders.GetFirst.GetExplorer.CommandBars.FindControl(, 5613).Execute 
End If 
End If 
End Sub 
Sub FindFolderByName() 
    Dim Name As String 
    Dim FoundFolder As Folder 

    Name = InputBox("Find Name:", "Search Folder") 
    If Len(Trim$(Name)) = 0 Then Exit Sub 

    Set FoundFouder = FindInFolders(Application.Session.Folders, Name) 

    If Not FoundFouder Is Nothing Then 
     If MsgBox("Activate Folder: " & vbCrLf & FoundFouder.FolderPath, vbQuestion Or vbYesNo) = vbYes Then 
      Set Application.ActiveExplorer.CurrentFolder = FoundFouder 
     End If 
    Else 
     MsgBox "Not Found", vbInformation 
    End If 
End Sub 
Function FindInFolders(TheFolders As Outlook.Folders, Name As String) 
    Dim SubFolder As Outlook.MAPIFolder 

    On Error Resume Next 

    Set FindInFolders = Nothing 

    For Each SubFolder In TheFolders 
     If LCase(SubFolder.Name) Like LCase(Name) Then 
      Set FindInFolders = SubFolder 
      Exit For 
     Else 
      Set FindInFolders = FindInFolders(SubFolder.Folders, Name) 
      If Not FindInFolders Is Nothing Then Exit For 
     End If 
    Next 
End Function 
+0

'FindInFolders' içindeki 'Exit For' ifadelerini dışarı çıkarın ve sonuçları bir çeşit toplama kabına koyun. – Comintern

+0

"Birincil posta kutusunda" Nisan "adıyla birden çok klasörü" sonra ayrı ayrı "aramak için Birden çok klasör arşivleri içinde" Nisan "adıyla. Http://stackoverflow.com/questions/27189429/searching-for-a-folder- in-outlook-folders-multiple-outes – niton

+0

@niton bağlantıda sağlanan kod ile, If Not MyFolder Is Nothing Then Exit For Matt

cevap

0

klasör FindInFolders fonksiyonunu ayrılmadan önce bulunup bulunmadığı kontrol edin:

İşte Geçerli çalışma kodudur.

Sub FindFolderByName() 

    Dim Name As String 
    Dim FoundFolder As Folder 

    Name = InputBox("Find Name:", "Search Folder") 
    If Len(Trim$(Name)) = 0 Then Exit Sub 

    ' Session.Folders is too broad 
    ' With Toggle Offline you probably have it narrowed down 
    ' to the folders you are interested in. 
    Set FoundFolder = FindInFolders(Session.Folders, Name) 

    ' Alternatives are PickFolder and hardcoding the folder 
    'Set FoundFolder = FindInFolders(Session.GetDefaultFolder(olFolderInbox).Folders, Name) 

    If FoundFolder Is Nothing Then 
     ' Move the confirmation inside the function 
     ' so the search does not end prematurely 
     MsgBox "Not Found", vbInformation 
    End If 

    Set FoundFolder = Nothing 

    Debug.Print "Done." 

End Sub 

Function FindInFolders(TheFolders As Outlook.Folders, Name As String) 

    'Dim SubFolder As Outlook.MAPIFolder 
    Dim SubFolder As Folder ' 2007 and subsequent 

    'On Error Resume Next 
    ' Only for a specific purpose and followed closely by 
    'On Error GoTo 0 

    Set FindInFolders = Nothing 

    For Each SubFolder In TheFolders 
     ' Stay online to see 
     ' the many unfamiliar folders in Session.Folders 
     Debug.Print " - " & SubFolder 

     If LCase(SubFolder.Name) Like LCase(Name) Then 

      Set FindInFolders = SubFolder 
      Set ActiveExplorer.CurrentFolder = FindInFolders 

      If MsgBox("Activate Folder: " & vbCrLf & FindInFolders.FolderPath, vbQuestion Or vbYesNo) = vbYes Then 
       Exit For 
      End If 

     Else 

      Set FindInFolders = FindInFolders(SubFolder.Folders, Name) 
      If Not FindInFolders Is Nothing Then Exit For 

     End If 

    Next 

End Function