Drafts in 1 x versturen

Status
Niet open voor verdere reacties.
P

pwarrens

Gebruiker
Lid geworden
21 okt 2016
Berichten
22
Hi,

Wie kan mij helpen met een stukje VBA? ik heb soms in mijn drafts 100 mailtjes staan die ik moet verzenden +attachement.
Alt+F11 om VBA te openen.. daarna open je +Project1+Microsoft Outlook Objects--Thisoutlooksession (F7)

Vervolgens heb ik deze macro code gebruikt maar die werkt niet... maar waarom? kan iemand mij miss de juiste geven aub

Public Sub EmailOutlookDraftsMessages()

Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder

'Send all items in the "Drafts" folder that have a "To" address filled in.

'Setup Outlook
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders

'Set Draft Folder.
Set myDraftsFolder = myFolders("Mailbox - pwarrens1@xxx.com").Folders("Drafts")

'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1

'Check for "To" address and only send if "To" is filled in.
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then

'Send Item
myDraftsFolder.Items.Item(lDraftItem).Send

End If

Next lDraftItem

'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing

End Sub

Alvast bedankt voor de hulp,

met vriendelijke groet,

Paul:cool:

mail name.JPG
 
Als eerste zet code alsjeblieft tussen code tags anders is het niet prettig lezen.

Krijg je errors? loopt het vast? ik zou eerst even een breakpoint zetten op de "if len(trim...." zetten en kijken of myDraftsFolder en idraftitem gevuld worden met een geldige waarde.
 
wampier zei:
Als eerste zet code alsjeblieft tussen code tags anders is het niet prettig lezen.

Krijg je errors? loopt het vast? ik zou eerst even een breakpoint zetten op de "if len(trim...." zetten en kijken of myDraftsFolder en idraftitem gevuld worden met een geldige waarde.
Klik om te vergroten...

Er gebeurt helemaal niks :/ maar wat bedoel je met code tags? en een breakpoint? ik heb de marcro code van internet geplukt en geprobeerd in te voeren ik ben niet zo bekend met VBA etc.
 
In je reageren "box" hier op het forum zie je in de header dingen zoals lettertype, smilies etc. je ziet ook een "#" icoon. als je daar met je muis overheen gaat staat er "de tag [code ] plaatsen".

breakpoint:

ga naar de line "if len(trim..." en klik helemaal aan de linkerkant (grijze lijn net buiten het tekstgebied) met je linkermuisknop. er komt nu een rood bolletje te staan. draai de macro en je code stopt bij het rode bolletje. Ga nu naar naar "view" in de menubalk -> "locals window" en vind daar myDraftsFolder en idraftitem. Eventueel op het "+"je voor de waarde klikken.
 
wampier zei:
In je reageren "box" hier op het forum zie je in de header dingen zoals lettertype, smilies etc. je ziet ook een "#" icoon. als je daar met je muis overheen gaat staat er "de tag [code ] plaatsen".

breakpoint:

ga naar de line "if len(trim..." en klik helemaal aan de linkerkant (grijze lijn net buiten het tekstgebied) met je linkermuisknop. er komt nu een rood bolletje te staan. draai de macro en je code stopt bij het rode bolletje. Ga nu naar naar "view" in de menubalk -> "locals window" en vind daar myDraftsFolder en idraftitem. Eventueel op het "+"je voor de waarde klikken.
Klik om te vergroten...

Code: 
Public Sub EmailOutlookDraftsMessages()

Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder

'Send all items in the "Drafts" folder that have a "To" address filled in.

'Setup Outlook
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders

'Set Draft Folder.
Set myDraftsFolder = myFolders("Mailbox - pwarrens1@xxx.com").Folders("Drafts")

'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1

'Check for "To" address and only send if "To" is filled in.
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then

'Send Item
myDraftsFolder.Items.Item(lDraftItem).Send

End If

Next lDraftItem

'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing

End Sub
 
wampier zei:
In je reageren "box" hier op het forum zie je in de header dingen zoals lettertype, smilies etc. je ziet ook een "#" icoon. als je daar met je muis overheen gaat staat er "de tag [code ] plaatsen".

breakpoint:

ga naar de line "if len(trim..." en klik helemaal aan de linkerkant (grijze lijn net buiten het tekstgebied) met je linkermuisknop. er komt nu een rood bolletje te staan. draai de macro en je code stopt bij het rode bolletje. Ga nu naar naar "view" in de menubalk -> "locals window" en vind daar myDraftsFolder en idraftitem. Eventueel op het "+"je voor de waarde klikken.
Klik om te vergroten...

Ik krijg nu de melding als ik op play druk; the macros in this project are disabled. please refer to the online help or documentation of the host application to determine how to enable macros.
 
Dan zou ik dat eerst doen, want als de macro niet loopt dan is het logisch dat er niet veel gebeurt :p
 
Dat is meestal een rechten ding tussen eventueel IT, jezelf, gebruikersinstellingen, veiligheidsinstellingen etc. etc. Dat is helaas een andere expertise waar ik niet zo inzit.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan