Problem XL 2016 - XL 2010

Function Sender_ermitteln()                                                     'temporär wegen  _
_
_
RD-Farm
Dim oADInfo As Object
Dim sUserName As String
Dim oUser As Object
Dim sMailAdd As String
Dim sName As String
' Auslesen der Daten aus dem Active Directory
Set oADInfo = CreateObject("ADSystemInfo")
sUserName = oADInfo.UserName
Set oUser = GetObject("LDAP://" & sUserName)
' Filterung bestimmter Daten
' cn = der Name, für jedes Objekt gibt es eine Abkürzung
sMailAdd = oUser.mail
sName = oUser.cn
Sender = oUser.mail
Set oUser = Nothing
Set oADInfo = Nothing
End Function

Function Sortieren()

Application.DisplayAlerts = False

Application.ScreenUpdating = False

Sheets("Empfänger").Visible = True

Sheets("Empfänger").Activate

Worksheets("Empfänger").Columns("A:C").Sort , Key1:=Range("A1"), _

Key2:=Range("B1"), Order1:=xlAscending, Header:=xlNo

Sheets("Empfänger").Visible = False

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Function

Function Sortieren2()

Application.DisplayAlerts = False

Application.ScreenUpdating = False

Sheets("Empfänger").Visible = True

Sheets("Empfänger").Activate

Worksheets("Empfänger").Columns("A:C").Sort , Key1:=Range("B1"), _

Order1:=xlAscending, Header:=xlNo

Sheets("Empfänger").Visible = False

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Function

Function Datum()

With UF_Gesprächsnotiz

.tb_datum.Value = Date

.tb_uhrzeit.Value = Time

End With

End Function

Function Dokument_leeren()

Dim objControl As Control

With UF_Gesprächsnotiz

For Each objControl In .Controls

Select Case TypeName(objControl)

Case "TextBox"

objControl.Text = ""

Case "ComboBox"

objControl.ListIndex = -1

Case "CheckBox"

objControl.Value = False

Case "OptionButton"

objControl.Value = False

End Select

Next

End With

Datum

End Function

Function senden(ByVal Nachricht As String)

Dim objOutlook As Object

Dim objMail As Object

Set objOutlook = CreateObject("Outlook.Application")

Set objMail = objOutlook.CreateItem(0)

With objMail

.To = UF_Gesprächsnotiz.tb_EmailAdresse.Value

.Subject = "Gesprächsnotiz"

.Body = Nachricht

.Send        'Sendet die Email automatisch

End With

Set objOutlook = Nothing

Set objMail = Nothing

Set objOutlook = CreateObject("Outlook.Application")

Set objMail = objOutlook.CreateItem(0)

With objMail

.To = Sender

.Subject = "Kopie - Gesprächsnotiz"

.Body = Nachricht

.Send        'Sendet die Email automatisch

End With

Set objOutlook = Nothing

Set objMail = Nothing

End Function

Function Protokoll_ordner()

Dim path As String

path = Environ("USERPROFILE") & "\Documents\Koetter_Excel_Files"

If Dir(path, vbDirectory) = "" Then

MkDir (path)

MkDir (path & "\Gesprächsnotizen")

ElseIf Dir(path & "\Gesprächsnotizen", vbDirectory) = "" Then

MkDir (path & "\Gesprächsnotizen")

ElseIf Dir(path & "\Gesprächsnotizen\Protokolle", vbDirectory) = "" Then

MkDir (path & "\Gesprächsnotizen\Protokolle")

End If

End Function