Hallo zusammen,
ich möchte den bestehenden Inhalt einer Worddatei auslesen und in eine neue Worddatei , die bereits Text enthält, am Ende einfügen.
Nur leider ignoriert er die Anweisung.
Kann mir bitte jemand helfen ?
Denke ich zu kompliziert ?
Hier der Programmcode
Set wordApp = CreateObject("Word.Application" )
Dir$(File1$, 0) = ""
Call wordApp.Documents.Open (File1e$)
wordApp.visible = False
If wordApp.ActiveDocument Is Nothing Then
Exit Sub
Elseif wordApp.ActiveDocument.Type <> "Text" Then
Exit Sub
Elseif Len(wordApp.ActiveDocument.Selection) > 3060 Then
Msgbox("Too long selectection")
Exit Sub
Elseif Len(wordApp.ActiveDocument.Selection) = 0 Then
Exit Sub
End If
wordApp.ActiveDocument.Selection.Copy
buffer(nCopy) = wordApp.ActiveDocument.Selection
nPaste = nCopy
nCopy = nCopy + 1
If nCopy > 4 Then
nCopy = 0
End If
If nBufferSize < 5 Then
nBufferSize = nBufferSize + 1
End If
wordApp.ActiveDocument.Close
Set wordApp = CreateObject("Word.Application" )
Dir$(File2$, 0) = ""
Call wordApp.Documents.Open (File2$)
wordApp.visible = False
If wordApp.ActiveDocument Is Nothing Then
Exit Sub
Elseif wordApp.ActiveDocument.Type <> "Text" Then
Exit Sub
End If
If nBufferSize = 0 Then
Msgbox("Empty buffer")
Exit Sub
End If
wordApp.ActiveDocument.Selection = ""
curCol = wordApp.ActiveDocument.Selection.CurrentColumn
curLine =wordApp.ActiveDocument.Selection.CurrentLine
'get rid of new lines to obtain actulal string lenght
tempPasteStr = buffer(nPaste)
tempPasteStr = Replace(tempPasteStr, String(1, vbCr), "")
Dim pasteStrLen
pasteStrLen = Len(tempPasteStr)
wordApp.ActiveDocument.Selection = buffer(nPaste)
If pasteStrLen < 400 Then
ActiveDocument.Selection.MoveTo curLine, curCol
ActiveDocument.Selection.CharRight dsExtend, pasteStrLen
End If
nPaste = nPaste + 1
If nPaste >= nBufferSize Then
nPaste = 0
End If
wordApp.ActiveDocument.SaveAs File2$
wordApp.ActiveDocument.Close
Die Zweite Datei wird auch angelegt, nur leider ist der zu kopierende Inhalt nicht enthalten.
Beste Grüsse
Andreas