Skip to content
Scroll Up
ICT trainer en programmeur
Word VBA snippets
De onderstaande code zal het actieve document - onder dezelfde naam in dezelfde directory - opslaan als PDF-document en deze als bijlage toevoegen aan een concept e-mail in Outlook.
Option Explicit Dim objDoc As Document Dim strPDF As String Sub initEmailPDF() Set objDoc = ActiveDocument If objDoc.Path = "" Then MsgBox "Sla eerst het Word-document op!", vbExclamation Exit Sub End If strPDF = objDoc.Path & Application.PathSeparator & objDoc.Name & ".pdf" savePDF emailPDF End Sub Sub savePDF() objDoc.ExportAsFixedFormat OutputFileName:=strPDF, _ ExportFormat:=wdExportFormatPDF, _ OpenAfterExport:=False, _ OptimizeFor:=wdExportOptimizeForPrint, _ Range:=wdExportAllDocument, _ IncludeDocProps:=True, _ CreateBookmarks:=wdExportCreateWordBookmarks, _ BitmapMissingFonts:=True End Sub Sub emailPDF() Dim objOutlook As Object Dim objMail As Object Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) With objMail .To = "aan@email.nl" .CC = "cc@email.nl" .Subject = "onderwerp" .Body = "bericht" .Attachments.Add strPDF .Display End With Set objMail = Nothing Set objOutlook = Nothing End Sub
Lees drie niveaus uit een custom menu bar versie <= 2003
Sub leesCustomMenu() Set menuNiv1 = CommandBars.ActiveMenuBar For Each niv1 In menuNiv1.Controls If niv1.Caption = "Menu-omschrijving" Then Set menuNiv2 = niv1 For Each niv2 In menuNiv2.Controls Debug.Print niv2.Caption Set menuniv3 = niv2 For Each niv3 In menuniv3.Controls Debug.Print niv3.Caption Next niv3 Next niv2 End If Next niv1 End Sub
De onderstaande code zal het actieve document - onder dezelfde naam in dezelfde directory - opslaan als PDF-document en deze als bijlage toevoegen aan een concept e-mail in Outlook.
01 | Option Explicit |
02 |
03 | Dim objDoc As Document |
04 | Dim strPDF As String |
05 |
06 | Sub initEmailPDF() |
07 |
08 | Set objDoc = ActiveDocument |
09 | |
10 | If objDoc.Path = "" Then |
11 | MsgBox "Sla eerst het Word-document op!" , vbExclamation |
12 | Exit Sub |
13 | End If |
14 | |
15 | strPDF = objDoc.Path & Application.PathSeparator & objDoc.Name & ".pdf" |
16 |
17 | savePDF |
18 | emailPDF |
19 |
20 | End Sub |
21 |
22 | Sub savePDF() |
23 |
24 | objDoc.ExportAsFixedFormat OutputFileName:=strPDF, _ |
25 | ExportFormat:=wdExportFormatPDF, _ |
26 | OpenAfterExport:= False , _ |
27 | OptimizeFor:=wdExportOptimizeForPrint, _ |
28 | Range:=wdExportAllDocument, _ |
29 | IncludeDocProps:= True , _ |
30 | CreateBookmarks:=wdExportCreateWordBookmarks, _ |
31 | BitmapMissingFonts:= True |
32 |
33 | End Sub |
34 |
35 | Sub emailPDF() |
36 |
37 | Dim objOutlook As Object |
38 | Dim objMail As Object |
39 |
40 | Set objOutlook = CreateObject( "Outlook.Application" ) |
41 | Set objMail = objOutlook.CreateItem(0) |
42 |
43 | With objMail |
44 | . To = "aan@email.nl" |
45 | .CC = "cc@email.nl" |
46 | .Subject = "onderwerp" |
47 | .Body = "bericht" |
48 | .Attachments.Add strPDF |
49 | .Display |
50 | End With |
51 |
52 | Set objMail = Nothing |
53 | Set objOutlook = Nothing |
54 |
55 | End Sub |
Lees drie niveaus uit een custom menu bar versie <= 2003
01 | Sub leesCustomMenu() |
02 |
03 | Set menuNiv1 = CommandBars.ActiveMenuBar |
04 | |
05 | For Each niv1 In menuNiv1.Controls |
06 | |
07 | If niv1.Caption = "Menu-omschrijving" Then |
08 | |
09 | Set menuNiv2 = niv1 |
10 | |
11 | For Each niv2 In menuNiv2.Controls |
12 | |
13 | Debug.Print niv2.Caption |
14 | |
15 | Set menuniv3 = niv2 |
16 | |
17 | For Each niv3 In menuniv3.Controls |
18 | |
19 | Debug.Print niv3.Caption |
20 | |
21 | Next niv3 |
22 | |
23 | Next niv2 |
24 | |
25 | End If |
26 | |
27 | Next niv1 |
28 |
29 | End Sub |