Macro opslaan als .msg in Outlook

[Damaverick]

Goedendag,

ik heb na lang zoeken een macro gevonden die bijna alles doet wat ie moet doen.
Nl een bericht binnen Outlook opslaan .msg, naar een zelf aan te geven map.

Echter zit er een fout in de scripting.

Wanneer er nl een : of / of \ enz enz in de bestandsnaam staat werkt de macro niet.
En laat nou net er een : bij een Re of Fw bericht staan.

Outlook zelf filterd bij de fuctie "opslaan als..." deze tekens er uit, maar aan de andere kant kun je weer niet in outlook aangeven om .msg als standaard opslagbestand te kiezen. Vandaar deze Macro.

Zou iemand kunnen zeggen hoe het script automatisch : / \ er uit filterd.
Een tweede optie die erg gewenst zou zijn (alleen weet ik niet of het mogelijk is) is ipv zelf een locatie in te typen (bijv. d:\mail zoals nu het geval is) om een browse functie te krijgen zodat ik simpelweg naar de juiste map kan browsen.

Hier het betreffende script: (of misschien heeft iemand iets wat juist beter aan mijn wensen voldoen )

Sub VerplaatsHuidigeMailNaarMap() 
  Dim Item As Object 
  Dim Map As String 
  Dim Mail As Outlook.MailItem 
  
  Set Item = Application.Explorers(1).Selection(1) 
  If TypeName(Item) <> "MailItem" Then 
    MsgBox "Selecteer eerst een mailbericht...", vbInformation, "Opdracht niet mogelijk" 
    Exit Sub 
  End If 
  
  Map = InputBox("Map en bestandsnaam:", "Bericht opslaan in...", CurDir) 
  If CreateObject("Scripting.FileSystemObject").FolderExists(Map) Then 
    If Right(Map, 1) <> "\" Then 
      Map = Map + "\" 
    End If 
    Set Mail = Item 
    Mail.SaveAs Map & Mail.Subject & ".msg", olMSG 
    Mail.Delete 
  End If 
  
End Sub

Alvast bedankt voor de hulp.

 

[Damaverick]

Iemand hier nog eens naar kunnen kijken?

 

[snb]

Gebruik de menubalk: bestand/opslaan als/ .msg

 

[Damaverick]

natuurlijk kies ik niet voor niets voor een Macro aangezien Outlook standaard als .htm opslaat en je een handmatige actie moet doen om dat om te zetten naar .msg.

Gelieve te reageren op de vraag ipv onzinnige andere antwoorden te posten...

 

[crash]

Gelieve te reageren op de vraag ipv onzinnige andere antwoorden te posten...

Misschien even op een andere manier reageren, dit komt erg onvriendelijk over. Hou er rekening mee dat mensen hier vrijwillig helpen.

 

[Damaverick]

op zich is het ook redelijk logisch dat dit onvriendelijk overkomt.

Ik vraag duidelijk hulp bij een macro omdat de "opslaan als" functie niet hetgeen bied wat ik nodig heb (staat ook duidelijk in mijn vraag).

Om dan zo'n onzinnig antwoord te posten draagt totaal niets bij aan de functie van dit forum.

punt 1 lees de vraag goed en als die niet duidelijk is stel wedervragen.
(maar mijn vraag was heel duidelijk omschreven.)
punt 2 als je geen antwoord op de vraag hebt post dan ook niet het 1e wat in je opkomt, om maar ff een antwoord te geven, daar heeft de vraagsteller niets aan........

 

[groenenbb]

@Damaverick
Met je opmerkingen cq. nogal brutale verzoeken kom je niet ver. Alle mensen hier zijn bereid je te helpen tot waar hun kennis reikt op het gebied van je vraag.

De luiheid om handmatig de keuze te maken voor .msg voor het opslaan van de berichten wil je vertalen naar het maken van een VBA code. De tijd die je daarmee kwijt bent geweest had je veelvuldig de handmztige keuze kunnen doen voor.msg.

Echter om toch terug te komen op je vraag.

Misschien dat je aan onderstaande code iets hebt. Code is vanuit een ander forum en niet aangepast naar jou vraag.

Sub dossier() 
  With GetNamespace("MAPI").Folders(1).Folders("Archief") 
     For Each ml In .Items 
        c0=mid(ml.Recipients(1),instr(ml.recipients(1),"@")+1) 
        ml.SaveAs + left(c0,instr(c0,".")-1) +".msg" 
        ml.Delete 
      Next 
   End With 
Sub End

gr. Groenen

 

[Damaverick]

tja wat jij als luiheid ziet, zien anderen als handigheid om werk sneller te laten verlopen.....
Overigens het posten van een vraag wil niet altijd zeggen dat de vraag ook daadwerkelijk voor mijzelf bedoeld is..........

en volgens mij was mijn 1e vraag geen brutale verzoek, maar tja dat is maar net hoe je het ziet (en wilt zien).
Mijn overige reacties waren terecht aangezien ik duidelijk vermeld dat de standaard niet gewenst is door het missen van de keuze voor een standaard opslag bestand.

Als het dan een brutaal verzoek is om een gevonden code te plaatsen met de vraag of iemand er meer van weet en mij zou kunnen helpen.
En als het ook een brutaal verzoek zou zijn om een vraag te stellen of iemand er al naar heeft kunnen kijken So Be It.


om terug te komen op jou toevoeging:
Bedank, ik zal kijken of ik het werken kan gaan krijgen binnen het Macro en op de manier hoe ik het graag zou willen.

 

[erwinhamelink]

Volgens mij is je vraag simpel op te lossen met onderstaande code

Sub VerplaatsHuidigeMailNaarMap()
  Dim Item As Object
  Dim Map As String
  Dim BestandsNaam As String
  Dim Mail As Outlook.MailItem
  
  Set Item = Application.Explorers(1).Selection(1)
  If TypeName(Item) <> "MailItem" Then
    MsgBox "Selecteer eerst een mailbericht...", vbInformation, "Opdracht niet mogelijk"
    Exit Sub
  End If
  
  Map = InputBox("Map en bestandsnaam:", "Bericht opslaan in...", CurDir)
  If CreateObject("Scripting.FileSystemObject").FolderExists(Map) Then
    If Right(Map, 1) <> "\" Then
      Map = Map + "\"
    End If
    Set Mail = Item
    BestandsNaam = Replace(Mail.Subject, ":", "")
    BestandsNaam = Replace(BestandsNaam, "/", "")
    BestandsNaam = Replace(BestandsNaam, "\", "")
    BestandsNaam = Replace(BestandsNaam, "<", "")
    BestandsNaam = Replace(BestandsNaam, ">", "")
    BestandsNaam = Replace(BestandsNaam, ";", "")
    Mail.SaveAs Map & BestandsNaam & ".msg", olMSG
    Mail.Delete
  End If
  
End Sub

Ik hoop dat je hier nog wat aan heb
gr. Erwin

 

[snb]

Mag het ietsje minder ?

Sub opslaan_als_msg()
  For Each mi In Application.Explorers(1).Selection
     mi.SaveAs "C:\test.msg", olMSG
  Next
End Sub

PS. bedenk zelf een simpele methode om niet steeds hetzelfde bestand te overschrijven.

 

[erwinhamelink]

Hoi
Hierbij vb code om meer berichten op te kunnen slaan.
Ik ben geen VB specialist, maar kopieer stukjes code van internet

Sub VerplaatsHuidigeMailNaarMap()
Dim Item As Object
Dim Map As String
Dim BestandsNaam As String
Dim Mail As Outlook.MailItem

Map = InputBox("Map en bestandsnaam:", "Bericht opslaan in...", CurDir)
If CreateObject("Scripting.FileSystemObject").FolderExists(Map) Then
    If Right(Map, 1) <> "\" Then
        Map = Map + "\"
    End If

For Each Item In Application.Explorers(1).Selection
If TypeName(Item) <> "MailItem" Then
    MsgBox "Selecteer eerst een mailbericht...", vbInformation, "Opdracht niet mogelijk"
    Exit Sub
End If

Set Mail = Item
BestandsNaam = Replace(Mail.Subject, ":", "")
BestandsNaam = Replace(BestandsNaam, "/", "")
BestandsNaam = Replace(BestandsNaam, "\", "")
BestandsNaam = Replace(BestandsNaam, "<", "")
BestandsNaam = Replace(BestandsNaam, ">", "")
BestandsNaam = Replace(BestandsNaam, ";", "")
If Dir(Map & BestandsNaam & ".msg") <> "" Then
    BestandsNaam = BestandsNaam & " " & Mail.ReceivedTime
    BestandsNaam = Replace(BestandsNaam, ":", "-")
End If
Mail.SaveAs Map & BestandsNaam & ".msg", olMSG
Mail.Delete
Next
End If
End Sub

Opm. Het kan zijn dat er nog tekens toegevoegd moeten worden als je problemen heb met opslaan van bepaalde emails. Je kan deze eenvoudig toevoegen door onderstaande regels er tussen te zetten met andere tekens.
BestandsNaam = Replace(BestandsNaam, "?", "")

Groetjes Erwin

 

[huijb]

Voor een ieder die niet weet hoe deze sectie werkt http://www.helpmij.nl/forum/showthread.php?t=321171

Voor diegene die zijn vraag in iemand anders zijn topic plaatst;
Graag een eigen vraag maken a.u.b. Het is niet netjes om in een ander zijn of haar vraag jouw probleem aan de orde te stellen. Bovendien is het verwarrend voor de helpers.

 

[huijb]

@AxiMaxi Graag een eigen vraag maken a.u.b. Het is niet netjes om in een ander zijn of haar vraag jouw probleem aan de orde te stellen. Bovendien is het verwarrend voor de helpers.