
Option Compare Database
Option Explicit

Private Sub Briefanrede_GotFocus()
    'Füllt das Briefanrede-Feld - sofern es leer ist - mit einer automatisch
    'generierten Anredeformel.
    '© 2000, Ralf Nebelo

    If IsNull(Briefanrede.Value) Then
        If IsNull(Nachname.Value) Then
            Briefanrede.Value = "Sehr geehrte Damen und Herren"
        Else
            If Anrede.Value = "Frau" Then
                Briefanrede.Value = "Sehr geehrte Frau " & Nachname.Value
            Else
                Briefanrede.Value = "Sehr geehrter Herr " & Nachname.Value
            End If
        End If
    End If
End Sub

Private Sub cmdBrief_Click()
    'Legt ein neues Briefdokument auf Grundlage der Serienbriefvorlage
    'AC-Brief.dot an und kopiert die im Access-Formular angezeigte
    'Adresse hinein.
    '© 2000, Ralf Nebelo

    Dim objDB As Database
    Dim objAbfrage As QueryDef
    Dim strSQLAbfrage As String
    Dim objWord As Object
    Dim strPfad As String
    Dim intPosi As Integer
    Const wdFormLetters = 0
    Const wdNotAMergeDocument = -1
    Const wdGoToBookmark = -1
    
    On Error Resume Next
    
    Set objWord = CreateObject("Word.Application")
    If objWord Is Nothing Then
        MsgBox "Word kann nicht gestartet werden."
        Exit Sub
    End If
    
    Set objDB = CurrentDb
    strSQLAbfrage = "SELECT * FROM adressen WHERE kennung = " & Kennung.Value
    Set objAbfrage = objDB.CreateQueryDef("tmpAbfrage", strSQLAbfrage)
    
    With objWord
        .Visible = True
        
        For intPosi = Len(CurrentDb.Name) To 1 Step -1
            If Mid(CurrentDb.Name, intPosi, 1) = "\" Then
                strPfad = Left(CurrentDb.Name, intPosi - 1)
                Exit For
            End If
        Next
    
        .Documents.Add Template:=strPfad & "\AC-Brief.dot", NewTemplate:=False
        With .ActiveDocument.Mailmerge
            .MainDocumentType = wdFormLetters
            .OpenDataSource Name:=CurrentDb.Name _
            , Connection:="QUERY tmpAbfrage", LinkToSource:=True
            .ViewMailMergeFieldCodes = False
            .MainDocumentType = wdNotAMergeDocument
        End With
        .Selection.GoTo What:=wdGoToBookmark, Name:="Brieftext"
        .Activate
        Set objWord = Nothing
    End With
    
    objDB.QueryDefs.Delete "tmpAbfrage"
    Set objDB = Nothing
    Set objAbfrage = Nothing
End Sub

Private Sub cmdExport_Click()
    'Exportiert die im Access-Formular angezeigte Adresse nach Outlook.
    '© 2000, Ralf Nebelo
    
    Dim objOL As Object
    Dim objOLKontakt As Object
    Const olContactItem = 2
    
    On Error Resume Next
    
    Set objOL = CreateObject("Outlook.Application")
    If objOL Is Nothing Then
        MsgBox "Outlook kann nicht gestartet werden."
        Exit Sub
    End If
    
    Set objOLKontakt = objOL.CreateItem(olContactItem)
    With objOLKontakt
        .CompanyName = Firma.Value
        .Department = Abteilung.Value
        .Title = Anrede.Value
        .LastName = Nachname.Value
        .FirstName = Vorname.Value
        .MailingAddressStreet = Adresse.Value
        .MailingAddressPostalCode = PLZ.Value
        .MailingAddressCity = Ort.Value
        .MailingAddressCountry = Land.Value
        .Display
    End With
End Sub

Private Sub cmdSchließen_Click()
    DoCmd.Close
End Sub
