Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1500to1504
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

4198 Befehl misslungen

4198 Befehl misslungen
27.06.2016 21:08:58
Ben
Hallo, dass folgende VBA-Skript liefer leider einen Fehler.
Ich benutze Word und Excel in der Version 2013. Ich bin über jede Hilfe dankbar.
Public Sub Serienbriefdruck()
Debug.Print "#### Starte Serienbriefdruck!"
On Error GoTo ErrHandler
Dim from As String
Dim tabelle As String
Dim wdApp As Object
Dim dok As Object
Dim name As String
tabelle = ActiveWorkbook.name
'Serienbrief drucken
'Word öffnen
Set wdApp = CreateObject("Word.Application")
'TODO auf False setzen, damit Erstellung im Hintergrund läuft
wdApp.Visible = True
'wdApp.ScreenUpdating = False
'wdApp.DisplayAlerts = False
pfad = Application.ActiveWorkbook.Path & "\"
datei = "Zuweisungen Zeugniskonferenz.docm"
Debug.Print pfad & datei
'Serienbrief öffnen
'MsgBox pfadSerienbrief & serienbrief
Set dok = wdApp.Documents.Open(pfad & datei)
dok.MailMerge.MainDocumentType = 0
dok.MailMerge.MainDocumentType = wdFormLetters
'Serienbrief aufrufen
src = pfad & ActiveWorkbook.name
Debug.Print src
For Each ws In ActiveWorkbook.Worksheets
If ws.name  "Vorbereitung" Then
ws.Activate
ActiveSheet.Range("B2").Value = ws.name
Debug.Print ws.name
from = "`" & ws.name & "$" & "`"
' HIER TRITT DER FEHLER AUF...
'dok.MailMerge.OpenDataSource name:=src, _
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=src;Mode=Read;Extended  _
Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global" _
, SQLStatement:="SELECT * FROM " & from, SQLStatement1:="", SubType:= _
wdMergeSubTypeAccess
dok.MailMerge.ViewMailMergeFieldCodes = False
'Serienbrief in eine neue Worddatei ausgeben
' With dok.MailMerge
'   .Destination = wdSendToNewDocument
'   .SuppressBlankLines = True
'End With
'wdApp.Run "DeleteEmptyRows()"
wdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
pfad & "Zuteilung " & ActiveWorkbook.ActiveSheet.name, _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, from:=beginnDS, To:=endeDS, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, _
DocStructureTags:=True, BitmapMissingFonts:=True, _
UseISO19005_1:=True
wdApp.ActiveDocument.Close savechanges:=False 'erzeugte Worddatei schliessen?
'wdApp.ScreenUpdating = False
'wdApp.DisplayAlerts = False
End If
Next ws
wdApp.Quit wdDoNotSaveChanges
Set dok = Nothing
Set wdApp = Nothing
Debug.Print "#### Serienbriefdruck abgeschlossen!"
Exit Sub
'Fehlerbehandlung
ErrHandler:
If Err.Number  0 Then
MsgBox "Fehler bei " & _
blatt & vbCrLf & _
CStr(Err.Number) & " " & Err.Description, vbExclamation + vbOKOnly
Debug.Print vbCrLf & CStr(Err.Number) & " " & Err.Description
End If
wdApp.Quit wdDoNotSaveChanges
Set dok = Nothing
Set wdApp = Nothing
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: 4711 Analyse misslungen
28.06.2016 09:18:11
EtoPHG
Hallo Ben,
Du mutest den Helfern etwas zuviel zu, denn in einem nicht kompilierbaren VBA-Code Fehler zu suchen, ist wie Stochern im Nebel. Keiner wird wohl deine Applikation nachbauen. Zur Fehlerbeschreibung " liefer leider einen Fehler." hab ich nirgends im World-Wide-Web Hilfreiches gefunden. Und Du?
Gruess Hansueli
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige