Thema Datum  Von Nutzer Rating
Antwort
16.08.2016 11:02:29 Marvin
NotSolved
16.08.2016 16:30:00 Gast11987
Solved
17.08.2016 09:38:07 Mavin
NotSolved
Blau Erklärung eines längeren Makros?
18.08.2016 16:41:00 Gast37639
Solved

Ansicht des Beitrags:
Von:
Gast37639
Datum:
18.08.2016 16:41:00
Views:
590
Rating: Antwort:
 Nein
Thema:
Erklärung eines längeren Makros?

Hallo! Hier ging nicht mehr so viel. Die App TOBIT kenne ich nicht. Gibt hier aber mal was, wo dein Code auch ist / war bzw. ähnlich vorhanden.

http://www.ms-office-forum.net/forum/showthread.php?t=290114

Ggf. mal dort noch nachfragen bzw. nac TOBIT suchen.

Soweit ich konnte, hier mal noch Erklärungen zum Code - einige Kommentare waren ja schon drin. VG

 


'allgmenes Object, dass für alle gilt, könnte eine eigene Klasse sein
Dim data As DataObject
Private Sub ToClipboard()


' Tastenkombination: Strg+J
'setzt das all. Object neu
    Set data = New DataObject
    Dim Text As String
    
    'nimmt dieAnzahl der untersch. Selektieren Bereich auf - also die, die nicht zusammenhägen und gleich groß sind
    nAreas = Selection.Areas.Count
    For nArea = 1 To nAreas 'Schleife durch alle markierten Bereiche
    'zählt die zeilen des Bereichs
        nRows = Selection.Rows.Count
        For nRow = 1 To nRows 'Schleife durch markierte Zeilen
            nCells = Selection.Rows(nRow).Cells.Count 'alle Zelle jeder Zeile
            For nCell = 1 To nCells 'Schleife durch Zellen
            'verkette den INhalt aller Zeilen in einen String getrennt mit ;
                Text = Text & Selection.Cells(nRow, nCell).Text & ";"

            Next nCell
            Text = Text & vbLf
        Next nRow
    Next nArea
    'weist den Text aller Zellen also den String an Data
    data.SetText Text
    'schiebt das in die Zwischenablage
    data.PutInClipboard
    
    ''''
    'Anmerkung. mE ungetestet könnte man das Auslesen der Zellen auch so machen
    'for each zelle in selection
    ' text = text und zelle.value & ";"
    'next

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, (...)
    'setzt wieder einen allg. Links auf die art des eintrages um sich das später zu sparen
    With oMailItem
    'betreff
    .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
    'oItem ist ein Object, dass irgendwo vermtl. global angelegt wurde
        'ist als HTMl Body angelegt - die Mail wird dann auch einen HTML Text haben, damit könne auch Tabellen rein
        HTML = oItem.BodyText.HTMLText

        'Fix für Umlaute da diese trotz UTF-8 komischerweise nicht sauber dargestellt werden
        HTML = FixHTMLUmlaute(HTML)
        'nimmt die Daten vomObject oItem. Da das hier nicht erfasst ist, wird es global aus einem anderen Makro kommen
        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

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
16.08.2016 11:02:29 Marvin
NotSolved
16.08.2016 16:30:00 Gast11987
Solved
17.08.2016 09:38:07 Mavin
NotSolved
Blau Erklärung eines längeren Makros?
18.08.2016 16:41:00 Gast37639
Solved