Guten Morgen,

Wow! Super! Danke, das hilft mir sehr viel weiter. Ich hätte da noch einige andere Makros dessen Erklärung benötigt würde :) Beim Sub InitTobit gehe ich davon aus das damit das Programm gestartet wird. Tobit Infocenter ist ein Kommunikations/Mailprogramm 

Hoffe das ist nicht zuviel verlangt

Liebe Grüße

Dim data As DataObject
Private Sub ToClipboard()


' Tastenkombination: Strg+J
    Set data = New DataObject
    Dim Text As String

    nAreas = Selection.Areas.Count
    For nArea = 1 To nAreas 'Schleife durch alle markierten Bereiche
        nRows = Selection.Rows.Count
        For nRow = 1 To nRows 'Schleife durch markierte Zeilen
            nCells = Selection.Rows(nRow).Cells.Count
            For nCell = 1 To nCells 'Schleife durch Zellen
                Text = Text & Selection.Cells(nRow, nCell).Text & ";"

            Next nCell
            Text = Text & vbLf
        Next nRow
    Next nArea

    data.SetText Text
    data.PutInClipboard
End Sub

Sub InitTobit()

Dim oApp
Dim oAccount
Dim oArchive
Dim oItem
Dim oMailItem
Dim oAttachment

Dim TobitPath
Dim TSrv
Dim Template

On Error Resume Next

  'Initialisiert die Tobit API
  
  'Anwendungsverzeichnis des Tobit InfoCenters aus der Registry auslesen
  Set WSHShell = CreateObject("WScript.Shell")
  ShellCmd = "HKCU\Software\Tobit\Tobit InfoCenter\Settings\ProgramDirectory"
  TobitPath = WSHShell.RegRead(ShellCmd)
  
  'Objekt der DvISEAPI erzeugen
   Set oApp = CreateObject("DVOBJAPILib.DvISEAPI")

  'Account laden (des lokal angemeldeten Benutzers)
  Set oAccount = oApp.Logon("", "", "", "", "", "NOAUTH")
  
  'Alle Archive einlesen
  Set oArchiveRoot = oAccount.ArchiveRoot
  Set oArchives = oArchiveRoot.Archives

  'Tobit Servernamen auslesen (Hostname des Tobit Servers in der Regel)
  TSrv = oAccount.ServerName
  
  'Vorlagenverzeichnis einlesen
  ShellCmd = "HKCU\Software\Tobit\Tobit InfoCenter\Servers\" & TSrv & "\TemplateFN"
  Template = WSHShell.RegRead(ShellCmd)
 
  'Falls möglich Vorlage einlesen
  If Template <> "" Then
    'Den Pfad abschneiden
    Path = Template
    filepart = Right(Template, 13)
    Path = Replace(Template, filepart, "")
        
    'Das Archiv ermitteln
    For Each oArc In oArchives
    If oArc.ID = Path Then
        'Das MailItem ermitteln
        For Each obj In oArc.AllItems
        If obj.TextSource = Template Then
            Set oItem = obj
        End If
        Next
    End If
    Next
  End If
End Sub

Sub Create_NewMail()

  'Tobit Archiv einlesen
  Set oArchive = oAccount.GetSpecialArchive(102) '102 = Ausgangsarchiv

  'Neuen Archiveintrag anlegen
  Set oMailItem = oArchive.CreateArchiveEntry(2) '0 = unbekannt, 1 = Adresse, 2 = Email, 3 = Fax, 4 = SMS, 5 = VoiceMail, 6 = TMAIL, 7 = Kalendereintrag, (...)
  
    With oMailItem

    .Subject = ""
    
    'Empfänger der Nachricht
    .Fields("SRTo").Value = "adress.management@skan-tours.de"

    'Priorität der Nachricht
    .Fields("Priority").Value = 0 '0 = Normal, 1 = Low, 2 = Important
    
    'Daten der Vorlage einlesen
    If Template <> "" Then

        HTML = oItem.BodyText.HTMLText

        'Fix für Umlaute da diese trotz UTF-8 komischerweise nicht sauber dargestellt werden
        HTML = FixHTMLUmlaute(HTML)
        Text = oItem.BodyText.PlainText
        Charset = oItem.BodyText.Charset

        .Fields("CONTENT").Value = Text
        .Fields("HTMLDisplayContent").Value = HTML
    End If
    
    'ggf. Dateianhänge hinzufügen
    '  .Attachments.Add Path & "\" & FileName ', "Angezeigte Bezeichnung des Anhangs"
    
    'Nachricht speichern
    .Save

    End With

    'Nummer des Eintrags der soeben gespeicherten Email auslesen (wichtig für Shell Aufruf!)
    oRecNo = oMailItem.Fields("RecNo").Value

    'Über die Shell das InfoCenter starten und dort die soeben erzeugte Nachricht im Editor öffnen
    Set WSHShell = CreateObject("WScript.Shell")
    ShellCmd = TobitPath & "\DVWIN32.EXE " & oArchive.ID & " /SA=34 /POS=" & oRecNo
    WSHShell.Exec (ShellCmd)

    'Mail sofort wieder löschen nachdem sie geöffnet wurde, da Sie sonst doppelt versendet wird, bzw. 2x im Postausgangsarchiv liegt
    oMailItem.Delete

    'Objekte freigeben um sicherzustellen, dass das Script auch bei mehrmaligem Aufrufen sauber funktioniert
    oAccount.Logoff
    Set oAccount = Nothing
    Set oApp = Nothing
    Set oAttachment = Nothing
    Set oMailItem = Nothing
    Set oArchive = Nothing
    Set oArchives = Nothing
    Set oItem = Nothing
    Set oArchiveRoot = Nothing
End Sub