outlook-vba - mails verplaatsen

[Morsyd]

Hallo,

programmeren in Excel lukt me aardig, maar in Outlook deed ik het nog nooit.
Ik wens iets te schrijven wat mijn mail automatisch verplaatst (niet via de standaard-regels die voor handen zijn, gezien je dit map per map moeten doen).
Ik heb namelijk een map met een 200-tal submappen, waarvan de mapnaam telkens begint met 4 cijfers. Bv.

0001 projectnaam 1
0002 projectnaam 2
0003 projectnaam 3
enzoverder

Nu had ik graag gehad, dan ik via de macro (die aan knop hangt) een pop-upvenster krijg die mij 4 cijfers vraagt (de 4 linkse karakters van de mapnaam dus).
Daarna moet de geselecteerde mail uit Postvak IN verplaatst worden naar de desbetreffende map.

Kan iemand me helpen? Alvast bedankt!

groeten

 

[snb]

Is dit een vraag of een opdracht ?

 

[Morsyd]

Is dit een vraag of een opdracht ?

Een vraag, of eerder: een vraag naar een aanzet.
Ik weet gewoon niet hoe te beginnen, hoe ik de map kan vinden die hoort bij de 4 cijfers...

Ik heb reeds het volgende (vanaf Set objDestFolder ben ik bezig in het ongewisse en hoop ik dus op wat raad...)

Sub verplaatsen()

Dim Boodschap, Titel, Standaard, MapNummer
Boodschap = "Geef het mapnummer waarnaar je deze mail wil verplaatsen" 
Titel = "Mail verplaatsen"
Standaard = "0000"
MapNummer = InputBox(Boodschap, Titel, Standaard)
Set objDestFolder = MapNummer

objItem.Move objDestFolder

Set objDestFolder = Nothing

End Sub

 

[snb]

Kijk dan eens hier:

http://www.snb-vba.eu/VBA_Outlook_external.html

 

[Morsyd]

Kijk dan eens hier:

http://www.snb-vba.eu/VBA_Outlook_external.html

Hartelijk dank voor deze website.
Ik ben er na veel proberen in geslaagd!

Enige probleem wat ik nu heb is de snelheid:
Via een do-loop until overloopt de macro één voor één de subfolders, tot de eerste 4 karakters van de MapNaam gelijk zijn aan de ingegeven nummer.
Dit deze loop gebeurt tot de 4 linkse karakters van de MapNaam gelijk zijn aan het opgegeven MapNummer OF tot de loop alle subfolders (AantalMappen) heeft overlopen.

Zie onderstaande code:

Do Until Left(Mapnaam, 4) = MapNummer Or i = AantalMappen
i = i + 1
Mapnaam = CreateObject("Outlook.Application").GetNamespace("MAPI").Folders(3).Folders(12).Folders(i).Name
Loop

In mijn oorspronkelijke mail zei ik dat er meer dan 200 subfolders waren, er blijken er echter meer dan 1000...
Bestaan er snellere manieren dan de hierboven opgegeven manier?

 

[snb]

Zeker wel

sub M_snb()
  for each it in CreateObject("Outlook.Application").GetNamespace("MAPI").Folders(3).Folders(12).folders
     c00=c00 & vblf & it.name
  next

  msgbox c00
end sub

 

[Morsyd]

Daarmee krijg ik een msgbox die een oplijsting maakt van alle subfolders + hun namen...
Doet toch niet hetzelfde als m'n do until-functie? De i = i+1 bij mij is om de volgende map te checken of de linkse 4 karakters overeenkomen met de 4 opgegeven cijfers...
Dit gebeurt tot de lijst ten einde is, of tot een gelijkenis is gevonden... En gezien het een lange lijst is duurt het lang

Ik vind maar niet hoe ik dit sneller kan laten gebeuren.

 

[snb]

Svp niet zinloos citeren/quoten !

 

[Morsyd]

excuses, aangepast... :s