17. Word, Outlook en Access

Attribute VB_Name = "mod1Oefeningen"

Option Explicit

Sub Oefening1()

    Dim objWord As Object
    Dim objDocument As Object
    
    Set objWord = CreateObject("Word.Application")
    Set objDocument = objWord.Documents.Add
    
    objWord.Visible = True
    
    objDocument.Content.InsertAfter Text:="Hello World"
    
    Set objDocument = Nothing
    Set objWord = Nothing
    
End Sub

Sub Oefening2()

    Dim objOutlook As Object
    Dim objMail As Object
 
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
    
    With objMail
        .To = "info@pascalterheege.nl"
        .CC = ""
        .Subject = "Testbericht"
        .Body = "Hello World"
        '.Attachment.Add ""
        .Display
        '.Send
    End With
    
    Set objMail = Nothing
    Set objOutlook = Nothing
    
End Sub

Sub Oefening3()

    Dim objCN As Object
    Dim objRS As Object
    
    Dim strBron As String
    
    Set objCN = CreateObject("ADODB.Connection")
    Set objRS = CreateObject("ADODB.RecordSet")
    
    strBron = ThisWorkbook.Path & "\Bronnen\Databank.accdb"
    
    With objCN
        .ConnectionString = "Provider = Microsoft.ACE.OLEDB.12.0; Data Source = " & strBron
        .Open
    End With
    
    With objRS
        .Open "SELECT * FROM Contactpersonen", objCN
        .MoveFirst
        Do While Not objRS.EOF
            Debug.Print .Fields("Voornaam").Value
            .MoveNext
        Loop
    End With
    
    Set objRS = Nothing
    Set objCN = Nothing
    
End Sub


Dim objOutlook As Object
Dim objMail As Object

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With objMail
	.To = "info@pascalterheege.nl"
	.CC = ""
	.Subject = "Testbericht"
	.Body = "Hello World"
	.Display
End With

Set objMail = Nothing
Set objOutlook = Nothing

Attribute VB_Name = "mod2Opdrachten"

' Opdracht 1: maak een afspraak in de agenda van Outlook

' Opdracht 2: laad de achternamen in Excel uit Access

' Opdracht 3: laad de achternamen in Word uit Excel

' Opdracht 4: laad de achternamen in een Word-tabel uit Excel

Attribute VB_Name = "mod3Antwoorden"

Option Explicit

' Opdracht 1: maak een afspraak in de agenda van Outlook

Sub Antwoord1()

    Dim objOutlook As Object
    Dim objAfspraak As Object
 
    Set objOutlook = CreateObject("Outlook.Application")
    Set objAfspraak = objOutlook.CreateItem(1)
    
    With objAfspraak
        .Subject = "Hello World"
        .Start = Now
        .Duration = 60
        .Save
    End With
    
    Set objAfspraak = Nothing
    Set objOutlook = Nothing
    
End Sub

' Opdracht 2: laad de achternamen in Excel uit Access

Sub Antwoord2()

    Dim objCN As Object
    Dim objRS As Object
    
    Dim strBron As String
    Dim i As Integer
    
    Set objCN = CreateObject("ADODB.Connection")
    Set objRS = CreateObject("ADODB.RecordSet")
    
    strBron = ThisWorkbook.Path & "\Bronnen\Databank.accdb"
    
    With objCN
        .ConnectionString = "Provider = Microsoft.ACE.OLEDB.12.0; Data Source = " & strBron
        .Open
    End With
    
    With objRS
        .Open "SELECT * FROM Contactpersonen", objCN
        .MoveFirst
        Do While Not objRS.EOF
            i = i + 1
            Cells(i, 1).Value = .Fields("Achternaam").Value
            .MoveNext
        Loop
    End With
    
    objCN.Close
    
    Set objRS = Nothing
    Set objCN = Nothing

End Sub

' Opdracht 3: laad de achternamen in Word uit Excel

Sub Antwoord3()

    Dim objWord As Object
    Dim objDocument As Object
    
    Dim rngBereik As Range
    Dim i As Integer
    
    Set objWord = CreateObject("Word.Application")
    Set objDocument = objWord.Documents.Add
    
    objWord.Visible = True
    
    Set rngBereik = Range("A1").CurrentRegion
    
    For i = 1 To rngBereik.Rows.Count
    
        With objDocument.Content
            .InsertAfter Text:=Cells(i, 1).Value
            .InsertParagraphAfter
        End With

    Next i
    
    Set objDocument = Nothing
    Set objWord = Nothing
    
End Sub

' Opdracht 4: laad de achternamen in een Word-tabel uit Excel

Sub Antwoord4()

    Dim objWord As Object
    Dim objDocument As Object
    Dim objTabel As Object
    
    Dim rngBereik As Range
    Dim i As Integer
    
    Set rngBereik = Range("A1").CurrentRegion
    
    Set objWord = CreateObject("Word.Application")
    Set objDocument = objWord.Documents.Add
    Set objTabel = objDocument.Tables.Add(Range:=objWord.Selection.Range, NumRows:=rngBereik.Rows.Count, NumColumns:=1)
    
    For i = 1 To rngBereik.Rows.Count
    
        With objDocument.Content
            objTabel.Cell(i, 1).Range.Text = Cells(i, 1).Value
        End With

    Next i
    
    objWord.Visible = True
    
    Set objDocument = Nothing
    Set objWord = Nothing

End Sub