Clever-Excel-Forum

Normale Version: Excel Button liest Datenquelle nicht ein und Zeichenfolge zu lang
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Einen schönen guten Morgen an alle,

folgendes neues Problem ist aufgetreten - ich versuche ja jetzt schon länger ein Serienbriefdokument über einen Excelbutton zu öffnen. Dies ist mir mit Hilfe dieses Forums, zwar zwischenzeitlich halbwegs gelungen, aber es funktioniert noch nicht ganz.  :20:

Der Code zum öffnen lautet:

 Private Sub CommandButton4_Click()

Dim oWrd As Object
Dim oDocx As Object
Dim strSheetName As String
strSheetName = "Rechnungsausgabe"
Set oWrd = CreateObject("word.application")
Set oDocx = oWrd.Documents.Open(ThisWorkbook.Path & Application.PathSeparator & "Rechnung.docx")
oWrd.Visible = True

oDocx.MailMerge.MainDocumentType = wdFormLetters
oDocx.MailMerge.OpenDataSource Name:= _
       ThisWorkbook.Path & Application.PathSeparator & "Rechnung.docx", _
       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=ThisWorkbook.Path & Application.PathSeparator & Gebührenrechner.docx.xlsm;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;J" _
       , SQLStatement:="SELECT * FROM [" & strSheetName & "$]", SQLStatement1 _
       :="", SubType:=wdMergeSubTypeAccess

Set oDocx = Nothing
Set oWrd = Nothing


End Sub

Problem 1 hierbei ist, dass die Datenquelle nicht nicht mit eingelesen wird (ich weiß aber das dies geht, nur nicht wie); Problem 2: ich bekomme immer die Meldung "Laufzeitfehler 9105, Die Zeichenfolge ist länger als 255 Zeichen".

Weiß jemand wie diese beiden Probleme noch lösen kann?  Huh

Viele Grüße

Basti
Hallo Basti,

der Beitrag ist ohne eine Antwort auf erledigt gesetzt. Das ist ok?
Hi,

wie du selbst erkannt hast, konnte mir diese Frage hier leider niemand beantworten. Ich konnte das Problem zwischenzeitlich mit der Hilfe von jemanden anders lösen.  Von daher- ja, das Thema ist erledigt.

Viele Grüße

Basti
Hi Bastian,
auch wenn dir hier niemand helfen könnte, würdest du uns trotzdem deine Lösung verraten?
Hi,

anbei die Lösung:

(In VBA Modul 3)

Option Explicit


Option Private Module 'damit kann man die Prozeduren nicht per Alt+F8 starten

'interne Word-Konstanten in Excel nachbilden
Const wdOpenFormatAuto As Integer = 0
Const wdFormLetters As Integer = 0
Const wdSendToNewDocument As Integer = 0
Const wdSendToPrinter As Integer = 1
Const wdDefaultFirstRecord As Integer = 1
Const wdDefaultLastRecord As Integer = -16
Const wdMergeSubTypeAccess As Integer = 1
Const wdFirstDataSourceRecord As Integer = -6
Const wdFormatPDF As Integer = 17
Const wdPrintAllDocument As Integer = 0
Const wdFormatXMLDocument As Integer = 12

'hier geht es los!
Sub Start_SB()
    Dim oWrd As Object, oDoc As Object
    Dim wb As Workbook, ws As Worksheet
    Dim strSheetName As String, xDocV As String, xSql As String
    
    On Error Resume Next
       'prüfen, ob Word schon aktiv ist
       Set oWrd = GetObject(, "Word.Application")
       If oWrd Is Nothing Then
          'wenn nicht, dann Word erst malö öffnen
          Set oWrd = CreateObject("Word.Application")
       End If
    On Error GoTo 0
    If oWrd Is Nothing Then
       MsgBox "Auf diesem Rechner ist M$-Word nicht installiert!", vbSystemModal + 16, "Hinweis...!"
       Exit Sub
    End If
       
    'diese Arbeitsmappe
    Set wb = ThisWorkbook
    '2. Tabellenblatt
    Set ws = wb.Worksheets(2)
    strSheetName = ws.Name
       
    'Ort der Word-Vorlage Serie3nbrief auf dem Datenträger
    'hier wird davon ausgegangen, das sich Word- & Exceldatei im gleichen Verzeichnis befinden
    xDocV = wb.Path & "\Rechnung.docx"
    
    'hierin befinden sich die {MergeField ...} und der sonstige Brieftext
    Set oDoc = oWrd.Documents.Add(Template:=xDocV, NewTemplate:=False, DocumentType:=0)

    oWrd.Visible = True

   'neugeöffnete Datei in Serienbrief-Hauptdokument umwandeln
    oDoc.MailMerge.MainDocumentType = wdFormLetters
    
    'Fatenfeld-Auswahl in SQL-Schreibweise
    xSql = "SELECT * FROM [Rechnungsausgabe$]"
    'Datenquelle hinzufügen
    oDoc.MailMerge.OpenDataSource Name:=wb.FullName, _
        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=" & wb.FullName & _
        ";Mode=Read;Extended Properties=""Excel 12.0 Macro;HDR=YES;IMEX=1;""", _
        SQLStatement:=xSql, SQLStatement1:="", SubType:=wdMergeSubTypeAccess
        
        'Hinweis
        'ab Office 2007 sollte der hier angewendete Treiber benutzt werden
        'bei *.xlsm als Datenquelle
        '";Extended Properties=""Excel 12.0 Macro; HDR=YES; IMEX=1"""
        
        'bei *.xlsx als Datenquelle
        '";Extended Properties=""Excel 12.0 Xml; HDR=YES; IMEX=1"""

        'alter Daten-Treiber - Bitte nur bei Zugriff auf *.xls-Dateien (bis Excel 2003) benutzen
        '"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=user;Data Source=" & wb.FullName & "Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB" _
        ', SQLStatement:="SELECT * FROM `2017$`", SQLStatement1:="", SubType:= _
        'wdMergeSubTypeAccess

    'beide Objektvariablen für Word ins Nirvana schicken
    Set oDoc = Nothing
    Set oWrd = Nothing
    
    'Das fertige Word-SB-Hauptdockument ist noch geöffnet aber nicht gespeichert!
    
    MsgBox "Fertig! Sie können Ihre Rechnungen jetzt ausdrucken", vbSystemModal + 64, "Hinweis...'"
End Sub


Private Sub CommandButton4_Click()
 Modul3.Start_SB

End Sub

VG