Drafts in 1 x versturen

[pwarrens]

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

 

[wampier]

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.

 

[pwarrens]

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.

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.

 

[wampier]

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.

 

[pwarrens]

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.

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

 

[pwarrens]

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.

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.

 

[wampier]

Dan zou ik dat eerst doen, want als de macro niet loopt dan is het logisch dat er niet veel gebeurt

 

[pwarrens]

Dan zou ik dat eerst doen, want als de macro niet loopt dan is het logisch dat er niet veel gebeurt

haha idd alleen hoe krijg ik dit nu weer voor elkaar haha

 

[wampier]

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.

 

[pwarrens]

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.

Het is gelukt