Option Explicit

Private Type AzLfdRecord
  AZ As String * 15
  lfdNr As Integer
End Type

Sub AutoNew()
' Die Anweisungen unten bewirken, dass bereits mit der Erstellung eines neuen
' Dokuments auf Basis dieser Dokumentvorlage das Aktenzeichen zugeordnet wird.
' ggf. durch REM oder "'" deaktivieren!

If Tasks.Exists("Aktenplan") Then
  AZzuordnen
  ActiveDocument.Saved = True
End If

End Sub

Public Sub AZzuordnen()

' Mischt ein Aktenzeichen aus dem Aktenplan in ein Textdokument ein.
' für Word Version 2000
' Autor: Christoph Müller (www.must.de)
' Stand: 19.08.99
' Modifikation und Weitergabe erlaubt
'
' Voraussetzungen:
' 1. Aktenplan.exe muß gestartet sein.
' 2. Ein Aktenzeichen muß ausgewählt (markiert) sein.
' 3. Das aktive Dokument muß eine Textemarke "Aktenzeichen" enthalten.

Dim Kanalnummer As Integer
Dim Aktenzeichen As String
Dim AktenzeichenText As String

' Lesen der Aktenplan-Server-Angaben
On Error GoTo EndAz
Kanalnummer = WordBasic.DDEInitiate("Aktenplan", "Aktenplan")
Aktenzeichen = WordBasic.DDERequest$(Kanalnummer, "Aktenzeichen")
AktenzeichenText = WordBasic.DDERequest$(Kanalnummer, "AktenzeichenText")
WordBasic.DDETerminate Kanalnummer
On Error GoTo 0

If Aktenzeichen = "" Then Exit Sub

' Entfernung des Carriage Returns:
If Len(Aktenzeichen) > 1 Then Aktenzeichen = WordBasic.Left$(Aktenzeichen, Len(Aktenzeichen) - 1)
If Len(AktenzeichenText) > 1 Then AktenzeichenText = WordBasic.Left$(AktenzeichenText, Len(AktenzeichenText) - 1)

' Aktenzeichen merken (für Dokumentablage)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Item("Aktenzeichen").Delete
On Error GoTo 0
ActiveDocument.CustomDocumentProperties.Add _
  Name:="Aktenzeichen", _
  LinkToContent:=False, _
  Type:=msoPropertyTypeString, _
  Value:=Aktenzeichen

' Zuordnung zu Textmarken, falls vorhanden
If WordBasic.ExistingBookmark("Aktenzeichen") = -1 Then
  WordBasic.EditGoTo Destination:="Aktenzeichen"
  WordBasic.Insert Aktenzeichen + "/" + Trim$(Str$(getAzLfdNr(Aktenzeichen)))
'                              ^-- entfernen, falls lfd. Nr. unerwünscht ---^
End If
If WordBasic.ExistingBookmark("AktenzeichenText") = -1 Then
  WordBasic.EditGoTo Destination:="AktenzeichenText"
  WordBasic.Insert AktenzeichenText
End If

EndAz:

End Sub

Public Sub SpeichernMitLfdNrZumAktenzeichen()

' Speichert das aktive Dokument unter dem Aktenzeichen plus laufender Nr. ab.
' Autor: Christoph Müller (www.must.de)
' Stand: 19.08.99
' Modifikation und Weitergabe erlaubt

Dim Aktenzeichen As String

Aktenzeichen = ""
On Error Resume Next
Aktenzeichen = ActiveDocument.CustomDocumentProperties.Item("Aktenzeichen")
On Error GoTo 0

If Aktenzeichen = "" Then
  MsgBox ("Kein Aktenzeichen aktiv.")
  Exit Sub
End If

ActiveDocument.SaveAs (Aktenzeichen + "-" + Trim$(Str$(getAzLfdNr(Aktenzeichen))) + ".doc")

End Sub
Private Function getAzLfdNr(aktuellesAZ As String) As Integer

' Einfache Lösung der laufenden Durchnumerierung zu einem Aktenzeichen.
' Erwartet Aktenzeichen.
' Liefert laufende Nummer zu diesem Aktenzeichen zurück.
' Hinweis: Für die gemeinsame Verwendung die Open-Anweisung auf einen
' entsprechenden Server-Pfad ändern.
' Autor: Christoph Müller (www.must.de)
' Stand: 19.08.99
' Modifikation und Weitergabe erlaubt

Dim AzLfdRecord1 As AzLfdRecord
Dim position As Integer
Dim istEnthalten As Boolean

getAzLfdNr = 0
On Error Resume Next
getAzLfdNr = ActiveDocument.CustomDocumentProperties.Item("lfd. Nummer zum Aktenzeichen")
On Error GoTo 0

If getAzLfdNr <> 0 Then
  Exit Function
End If

istEnthalten = False

Open Options.DefaultFilePath(wdDocumentsPath) + "\AzLfdNr" For Random As #1 Len = Len(AzLfdRecord1)
position = 1
While Not EOF(1)
  Get #1, position, AzLfdRecord1
  If RTrim$(AzLfdRecord1.AZ) = RTrim$(aktuellesAZ) Then
    istEnthalten = True
    AzLfdRecord1.lfdNr = AzLfdRecord1.lfdNr + 1
    getAzLfdNr = AzLfdRecord1.lfdNr
    Put #1, position, AzLfdRecord1
  End If
  position = position + 1
Wend

If Not istEnthalten Then
  getAzLfdNr = 1
  AzLfdRecord1.AZ = aktuellesAZ
  AzLfdRecord1.lfdNr = 1
  Put #1, position, AzLfdRecord1
  getAzLfdNr = 1
End If

Close #1

With ActiveDocument.CustomDocumentProperties
  .Add Name:="lfd. Nummer zum Aktenzeichen", _
    LinkToContent:=False, _
    Type:=msoPropertyTypeNumber, _
    Value:=getAzLfdNr
End With

End Function