Guten Tag,

ich habe folgendes Problem.

Ein Freund von mir hat mir ein von mir erstelltes Word VBA Macro umgeschrieben um eine Funktion hinzuzufügen welche ich benötige. Das Word Dokument prüft beim Speichervorgang Pflichtfelder auf Vollständigkeit. Sind alle Felder ausgefüllt, werden die Daten aus dem Word Dokument an eine Excel Liste übergeben. Diese Liste wird fortgehend weiter mit Daten bestückt wenn nach und nach Dokumente ausgefüllt und gespeichert werden.

Nun hat mein Freund eine Funktion eingebaut die erkennt ob ein Dokument bereits gespeichert wurde, damit es nicht mehr zu Doppeleinträgen kommt. Das Word Dokument speichert intern eine variable ab sobald es zum ersten mal gespeichert wird. Diese Variable wird auch an die Excel Liste übergeben. Wird ein weiteres mal gespeichert, so erkennt das Dokument das es bereits abgespeichert wurde und stellt den Benutzer vor die Wahlmöglichkeit das Dokument ein weiteres mal abzuspeichern und die bereits übergebenen Daten in der Excel Liste zu aktualisieren der das Dokument zu speichern ohne die Daten zu aktualisieren oder den Vorgang zu beenden. So zumindest die Theorie...

Nun gibt es in der Praxis ein paar Probleme.

Beim ersten Speichern wird die variable erstellt, die Daten übergeben, alles funktioniert soweit gut. Beim erneuten speichern erkennt das Dokument das es bereits abgespeichert wurde und die Abfrage findet statt. Jedoch wird bei allen drei Auswahlmöglichkeiten das selbe Ergebnis erzielt. Wird "Ja" ausgewählt, wird das Dokument erneut gespeichert aber die Daten werden nicht aktualisiert, sprich es wird in der Excel liste einfach ein neuer Eintrag hinzugefügt. Bei "Nein" und Abbrechen das gleiche. Leider ist mein Freund aus privaten Gründen nicht in der Lage weiter an dem Code zu arbeiten, weshalb ich mich hilfesuchend an dieses Forum wende. Eventuell erkennt ja jemand wo das Problem liegt und kann mir damit behilflich sein. Ich poste hier mal den Abschnitt der den Speichervorgang beschreibt und das Modul welches die Daten letztendlich an Excel überträgt.

Code für den Speichervorgang:

Option Explicit

Sub FileSave()
    Dim oDoc As Document
    Dim oVar As Variable
    Dim bVar As Boolean
    Dim lngID As Long
    Dim lngAsk As Long
    Dim vbCancel As Boolean, vbNo As Boolean, vbYes As Boolean
    Set oDoc = ActiveDocument
    If Checkfields = True Then
        If oDoc.Path = "" Then
            FileSaveAs
        End If
        For Each oVar In oDoc.Variables
            If oVar.Name = "varID" Then
                lngAsk = MsgBox("Das Prüfprotokoll wurde bereits in die Geräteliste exportiert." & vbCr & _
                "Wurden Daten im Protokoll geändert, kann der Eintrag in der Geräteliste aktualisiert werden!" & vbCr & _
                vbCr & _
                "Wähle 'Ja' um den Eintrag zu aktualisieren!" & vbCr & _
                "Wähle 'Nein' um das Dokument ohne aktualisierung zu speichern!" & vbCr & _
                "Wähle 'Abbrechen' um den Vorgang zu beenden!", vbYesNoCancel)
                Select Case lngAsk
                Case vbYes
                    MsgBox ("Daten werden überschrieben")
                    lngID = oVar.Value
                    bVar = True
                    Exit For
                Case vbNo
                    MsgBox ("Dokument gespeichert")
                    bVar = False
                    Exit For
                Case vbCancel
                    MsgBox ("Speichervorgang abgebrochen!")
                    GoTo lbl_Exit
                End Select
            End If
        Next oVar
        If Not bVar Then
            oDoc.Variables("varID").Value = "0"
            oDoc.Save
        End If
        DataTransfer CStr(lngID)
        If Not oDoc.Saved Then oDoc.Save
    End If
lbl_Exit:
    Exit Sub
End Sub

Code Auschnitt aus dem Modul für die Datenübertragung:

Sub DataTransfer(sID As String)
    Dim xlApp As Object
    Dim xlWBook As Object
    Dim fld As FormField
    Dim nRow As Long
    Dim nCol As Integer
    Dim ws As Object
    Dim ldfNr As Integer
    Dim varID As Long
    Dim NextID As Long
    Dim nInstall As String
    Dim nTech As String, nEqui As String, nTyp As String, nPTB As String, nSNR As String, nSicherungsart As String
    Dim nFDSS As String, nEXGRP As String, nBetriebsdruck As String, nBetriebstemp As String, nEinbaulage As String
    Dim nWirkrichtung As String, nFFA As String, nPMBAR As String, nVMBAR As String, nPVDTNG As String, nVVDTNG As String
    Dim nMWRKST As String, nMedium As String, nHeizung As String, nIsolierung As String, nAccess As String
    Dim nrow1 As Long
    
    Const xlUp = -4162
     
    Application.ScreenUpdating = False
     
    Set xlApp = CreateObject("excel.Application")
    Set xlWBook = xlApp.Workbooks.Open(ThisDocument.Path & "\artexGeräteliste.xlsx")
    xlWBook.Application.Visible = True
    xlWBook.Application.Sheets("Geräteübersicht").Select
    Set ws = xlWBook.Sheets("Geräteübersicht")
    If sID = "0" Then
    nRow = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row + 1
     'Column A is the column with the ID numbers - change as apppropriate
    NextID = xlApp.WorksheetFunction.Max(ws.Range("A:A")) + 1
     'add the new ID to column A
    ws.Cells(nRow, 1) = NextID
    ActiveDocument.Variables("varID").Value = NextID
    ActiveDocument.Save
    Else
        On Error Resume Next
        'Column A is the column with the ID numbers  - change as apppropriate
        nRow = xlApp.WorksheetFunction.Match(CLng(sID), ws.Range("A:A"), 0)
        If nRow = 0 Then nRow = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row + 1
        On Error GoTo 0
    End If
   
    ldfNr = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
    If ldfNr = 0 Then
        ws.Cells(ldfNr + 1, 2) = 1
    Else
        ws.Cells(ldfNr + 1, 2) = ldfNr - 2
    End If
    Cells(nRow, 1).RowHeight = 18

...

nrow1 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row - nRow
    If nrow1 > 0 Then
    Cells(nRow + 1, 2).Resize(nrow1).EntireRow.Delete
    End If
Application.ScreenUpdating = True
xlWBook.Close SaveChanges:=True
Application.Quit SaveChanges:=True

End Sub

Es würde mich sehr freuen wenn hier mal jemand drüber schauen könnte um eventuell den Fehler ausfindig zu machen. Mich wurmt warum die Daten beim erneuten speichern nicht aktualisiert werden sondern lediglich ein neuer Eintrag erstellt wurde und warum bei Nein und Abbrechen genau das gleiche passiert.

                Case vbYes
                    MsgBox ("Daten werden überschrieben")

Auch die Message Box wird beim Ausführen nicht angezeigt.

Gruß

Manuel