Eingebundene Word werden nur beim 1. Go exportiert
04.05.2006 14:56:35
R.Schmitt
mit dem beiliegenden Code, der für Excel97 und Word97
konzipiert ist, exportieren wir eingebundene WordDokumente
aus Excel als Dateien in ein Verzeichnis.
Das klappt hervorragend
Aber nur beim ersten Mal
Sollen die Dokumente ein weiteres Mal exportiert werden,
wird an ihrer Stelle lediglich eine leere Datei ohne Inhalt
gespeichert.
Schließen wir die Datei wieder klappt nach erneutem Öffnen der
erste Export wieder ohne Probleme. Beim zweiten Export wieder
nur leere Blätter. Und so weiter und so fort.
Nun meine Frage :
Was übersehen wir hier ? (mir wachsen grad´graue Haare)
Sub AUSGEWÄHLTE_BERICHTE_EXPORTIEREN()
Dim i, a, v, na, na2, bericht, länge
Dim myOLEObject As OLEObject
Dim appWord As Object
Dim dokument
Dim autor
autor = Sheets(1).Range("ab1").Value
WordDokumenteBeenden
Do Until Range("D10").Offset(i, 0).Value = ""
If Range("d10").Offset(i, 0).Value = True Then
Range("d10").Select
ActiveSheet.Unprotect
Range("d10").Offset(i, 6).Value = Now
dokument = Range("d10").Offset(i, 2).text
ActiveSheet.Shapes(dokument).Select
v = ""
Selection.Verb Verb:=xlPrimary
Set appWord = GetObject(, "Word.Application.8")
bolWordNeu = False
On Error GoTo 0
'wenn Word nicht bereits laeuft, dann neue Instanz
If appWord Is Nothing Then
Set appWord = CreateObject("Word.Application.8")
bolWordNeu = True
End If
Err.Clear
appWord.WindowState = wdWindowStateMaximize
appWord.Visible = True
bericht = "Dokument in " & ActiveWorkbook.Name
länge = appWord.ActiveWindow.Selection.StoryLength
appWord.Documents(bericht).SaveAs FileName:="C:\Auftragsrunde\" & " " & dokument & " " & autor, FileFormat:=wdFormatDocument, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
WordDokumenteBeenden
End If
i = i + 1
Loop
Range("d10:d60").Value = False
Range("c7").Select
ActiveSheet.Protect
WordDokumenteBeenden
Range("c7").Select
End Sub
Für eure Mühe Herzlichen Dank
R.Schmitt