Ş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
'FindInFolders' içindeki 'Exit For' ifadelerini dışarı çıkarın ve sonuçları bir çeşit toplama kabına koyun. – Comintern
"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
@niton bağlantıda sağlanan kod ile,
If Not MyFolder Is Nothing Then Exit For
– Matt