Unterformular aus Acces in ein schon geöffnetes Word Dokument übergeben

edgar113 · 28. Oktober 2010

Hallo,
ich habe folgendes Problem.
Hab auch im Forum gesucht aber nichts passendes gefunden.

Ich habe eine Datenbank mit einem Formular in dem ein Unterformular ist.
Das Formular heist frmOfferten und das Unterformular heist frmArtikelOfferte mit den Datenfeldern "IKS", "Bezeichnung" und "Generik".
Die Tabellen-Datenfelder "Bezeichnung" und "Generik" aus dem Unterformular möchte ich in ein schon geöffnetes Word dokument einfügen.
Ich habe leider nicht soviel ahnung von VBA
Ich hatte mir das folgendermassen vorgestellt.
Ich Drücke einen Button und anschließend werden alle Datensätze des gewählten Unterformulares in mein Worddokument kopiert.
Mit dem beigefügten Code hatte ich schon erfolg. Aber leider wird hier ein neues Word-Dokument geöffnet.
Wie gesagt mein Word-Dokument ist schon offen
Des Weiteren werden auch bei diesem Code leere Felder nicht übertragen bzw. es wird an der Stelle Abgebrochen.

PHP:

Private Sub DokumentFRZ_Click()
  Dim rs As DAO.Recordset
  Dim i As Integer
  Dim wordobj As word.Application
  Dim worddoc As word.Document
  Dim objBMRange As word.Range
  Dim VORLAGE As String
  Dim FS As FileSearch
  Dim test As Integer
  Dim Lesefiles As String
  Dim Laufwerksordner As String
  Dim strBMName As String
  Dim strBMText As String
  Dim strText As String
  Vorlagenordner = Application.CurrentProject.Path
  Set FS = Application.FileSearch
    With FS
        .LookIn = Vorlagenordner
        Debug.Print Vorlagenordner
        .NewSearch
        .SearchSubFolders = False
           'Filter für *.doc einstellen
        .FileName = "*.doc*"
        .Execute
        For i = 1 To .FoundFiles.Count
          Lesefiles = Lesefiles & ";" & Mid(.FoundFiles(i), Len(Vorlagenordner) + 2)
        Next i
    End With
   'Me!Dokument.RowSourceType = valuelist
    Me!DokumentFRZ.RowSource = Mid(Lesefiles, 2)
    Laufwerksordner = Vorlagenordner & "\" & Me!DokumentFRZ
        
   'Start Microsoft Word.
    Set wordobj = CreateObject("Word.Application")
   'Vorlage erstellen. Dadurch wird das Original nicht überschrieben
    VORLAGE = Laufwerksordner
          
          Set worddoc = wordobj.Documents.Add(Template:=VORLAGE)
    'Vorgeschlagener Ordner, wenn 'Speichern unter' in Word gewählt wird
    'Ordner muss schon existieren.
    'worddoc.Parent.ChangeFileOpenDirectory "e:\"
    With wordobj
       'Make the application visible.
        wordobj.Visible = True
       'wordobj.Activate
       'Open the document.
       'Move to each bookmark and insert text from the form.
       'Fehlerroutine für nicht vorhandene bookmarks in Wordvorlage
        On Error GoTo ERRORBEENDEN

        Set rs = Me![frmArtikelOfferte].Form.RecordsetClone
        rs.MoveLast
        rs.MoveFirst
        If Not (rs.EOF And rs.BOF) Then
        For i = 1 To rs.RecordCount
        
               
               'worddoc.Bookmarks("Pharmacode").Select
               'wordobj.Selection.TypeText Text:=CStr(rs!PH_Code)
               worddoc.Bookmarks("Bezeichnung").Select
               wordobj.Selection.TypeText Text:=CStr(rs!Bezeichnung)
               worddoc.Bookmarks("Generika").Select
               wordobj.Selection.TypeText Text:=CStr(rs!Generika)
               
               If i = rs.RecordCount Then Exit Sub 'Leerzeile vermeiden
               wordobj.Selection.InsertRows 1
               wordobj.Selection.Collapse Direction:=wdCollapseStart
               
                 'wordobj.Selection.MoveRight Unit:=wdCell
                'With worddoc
                   'Set objBMRange = wordobj.Selection.Range
                         '.Bookmarks.Add Name:="Pharmacode", Range:=objBMRange
                         '.Bookmarks.DefaultSorting = wdSortByName
                         '.Bookmarks.ShowHidden = False
                'End With
                 wordobj.Selection.MoveRight Unit:=wdCell
                With worddoc
                 Set objBMRange = wordobj.Selection.Range
                    .Bookmarks.Add Name:="Bezeichnung", Range:=objBMRange
                    .Bookmarks.DefaultSorting = wdSortByName
                    .Bookmarks.ShowHidden = False
                End With
                    wordobj.Selection.MoveRight Unit:=wdCell
                With worddoc
                 Set objBMRange = wordobj.Selection.Range
                    .Bookmarks.Add Name:="Generika", Range:=objBMRange
                    .Bookmarks.DefaultSorting = wdSortByName
                    .Bookmarks.ShowHidden = False
                End With
                  
            rs.MoveNext
            
          Next i
        End If
        rs.Close
        Set rs = Nothing
    End With
    Set worddoc = Nothing
    Set wordobj = Nothing
    Exit Sub
ERRORBEENDEN:
  Exit Sub
End Sub

Private Sub DokumentFRZ_Enter()
  Vorlagenordner = Application.CurrentProject.Path
  Dim i As Integer
  Dim Lesefiles As String
  Dim test As Integer
  Dim FS As FileSearch
  Set FS = Application.FileSearch
    With FS
        .LookIn = Vorlagenordner
        .NewSearch
        .SearchSubFolders = False
          'Filter für *.doc einstellen
        .FileName = "*.doc*"
        .Execute
        For i = 1 To .FoundFiles.Count
          Lesefiles = Lesefiles & ";" & Mid(.FoundFiles(i), Len(Vorlagenordner) + 2)
          'Debug.Print Lesefiles
        Next i
    End With
   'Me!comboVorlagenFRZ.RowSourceType = valuelist
    Me!DokumentFRZ.RowSource = Mid(Lesefiles, 2)
End Sub

Hat einer einen Tipp
Gruß Edgar

Yaslaw · 28. Oktober 2010

Nur mal schnell das ganze in VB-Tags anstelle von PHP-TZags, damit man es lesen kann

Visual Basic:

Private Sub DokumentFRZ_Click()
  Dim rs As DAO.Recordset
  Dim i As Integer
  Dim wordobj As word.Application
  Dim worddoc As word.Document
  Dim objBMRange As word.Range
  Dim VORLAGE As String
  Dim FS As FileSearch
  Dim test As Integer
  Dim Lesefiles As String
  Dim Laufwerksordner As String
  Dim strBMName As String
  Dim strBMText As String
  Dim strText As String
  Vorlagenordner = Application.CurrentProject.Path
  Set FS = Application.FileSearch
    With FS
        .LookIn = Vorlagenordner
        Debug.Print Vorlagenordner
        .NewSearch
        .SearchSubFolders = False
           'Filter für *.doc einstellen
        .FileName = "*.doc*"
        .Execute
        For i = 1 To .FoundFiles.Count
          Lesefiles = Lesefiles & ";" & Mid(.FoundFiles(i), Len(Vorlagenordner) + 2)
        Next i
    End With
   'Me!Dokument.RowSourceType = valuelist
    Me!DokumentFRZ.RowSource = Mid(Lesefiles, 2)
    Laufwerksordner = Vorlagenordner & "\" & Me!DokumentFRZ
        
   'Start Microsoft Word.
    Set wordobj = CreateObject("Word.Application")
   'Vorlage erstellen. Dadurch wird das Original nicht überschrieben
    VORLAGE = Laufwerksordner
          
          Set worddoc = wordobj.Documents.Add(Template:=VORLAGE)
    'Vorgeschlagener Ordner, wenn 'Speichern unter' in Word gewählt wird
    'Ordner muss schon existieren.
    'worddoc.Parent.ChangeFileOpenDirectory "e:"
    With wordobj
       'Make the application visible.
        wordobj.Visible = True
       'wordobj.Activate
       'Open the document.
       'Move to each bookmark and insert text from the form.
       'Fehlerroutine für nicht vorhandene bookmarks in Wordvorlage
        On Error GoTo ERRORBEENDEN

        Set rs = Me![frmArtikelOfferte].Form.RecordsetClone
        rs.MoveLast
        rs.MoveFirst
        If Not (rs.EOF And rs.BOF) Then
        For i = 1 To rs.RecordCount
        
               
               'worddoc.Bookmarks("Pharmacode").Select
               'wordobj.Selection.TypeText Text:=CStr(rs!PH_Code)
               worddoc.Bookmarks("Bezeichnung").Select
               wordobj.Selection.TypeText Text:=CStr(rs!Bezeichnung)
               worddoc.Bookmarks("Generika").Select
               wordobj.Selection.TypeText Text:=CStr(rs!Generika)
               
               If i = rs.RecordCount Then Exit Sub 'Leerzeile vermeiden
               wordobj.Selection.InsertRows 1
               wordobj.Selection.Collapse Direction:=wdCollapseStart
               
                 'wordobj.Selection.MoveRight Unit:=wdCell
                'With worddoc
                   'Set objBMRange = wordobj.Selection.Range
                         '.Bookmarks.Add Name:="Pharmacode", Range:=objBMRange
                         '.Bookmarks.DefaultSorting = wdSortByName
                         '.Bookmarks.ShowHidden = False
                'End With
                 wordobj.Selection.MoveRight Unit:=wdCell
                With worddoc
                 Set objBMRange = wordobj.Selection.Range
                    .Bookmarks.Add Name:="Bezeichnung", Range:=objBMRange
                    .Bookmarks.DefaultSorting = wdSortByName
                    .Bookmarks.ShowHidden = False
                End With
                    wordobj.Selection.MoveRight Unit:=wdCell
                With worddoc
                 Set objBMRange = wordobj.Selection.Range
                    .Bookmarks.Add Name:="Generika", Range:=objBMRange
                    .Bookmarks.DefaultSorting = wdSortByName
                    .Bookmarks.ShowHidden = False
                End With
                  
            rs.MoveNext
            
          Next i
        End If
        rs.Close
        Set rs = Nothing
    End With
    Set worddoc = Nothing
    Set wordobj = Nothing
    Exit Sub
ERRORBEENDEN:
  Exit Sub
End Sub

Private Sub DokumentFRZ_Enter()
  Vorlagenordner = Application.CurrentProject.Path
  Dim i As Integer
  Dim Lesefiles As String
  Dim test As Integer
  Dim FS As FileSearch
  Set FS = Application.FileSearch
    With FS
        .LookIn = Vorlagenordner
        .NewSearch
        .SearchSubFolders = False
          'Filter für *.doc einstellen
        .FileName = "*.doc*"
        .Execute
        For i = 1 To .FoundFiles.Count
          Lesefiles = Lesefiles & ";" & Mid(.FoundFiles(i), Len(Vorlagenordner) + 2)
          'Debug.Print Lesefiles
        Next i
    End With
   'Me!comboVorlagenFRZ.RowSourceType = valuelist
    Me!DokumentFRZ.RowSource = Mid(Lesefiles, 2)
End Sub

edgar113 · 28. Oktober 2010

Hallo,
wie gesagt habe ich nicht viel Ahnung.
Kann ich denn mit Hilfe rechnen?
Würde mich sehr weiterbringen.
Gruß Edgar

Yaslaw · 29. Oktober 2010

Wird das Word-Dokument von Hand geöffnet oder wird es in einem vorhergehenden Programmabschnitt geöffnet?

edgar113 · 29. Oktober 2010

Das Word-Dokument wir nicht von Hand geöffnet.
Es wird durch ein externes Programm (Firmeneigene Software) gestartet.
D.h. ich starte die Firmeneigene Software, wähle den Kunden aus.
Jetzt starte Die Firmensoftwar das Word-Dokument.
Für dieses Word-Dokument wird eine Wordvorlage verwendet.

Yaslaw · 29. Oktober 2010

Also müsstest du euf eine bereits laufende und dir unbekannte Word-Instanz zugreiffen..... Ist mir grad nicht bekannt dass das ginge.

Du kannst die ProcessIDs aller geöffnet Word-Instancen ermitteln, ggf. sogar welche der Words von der anderen Applikation geöffnet ist, aber dann ist da bals mal fertig lustig.
Basierend auf http://www.activevb.de/tipps/vb6tipps/tipp0273.html

Visual Basic:

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" _
        (ByVal lFlags As Long, ByVal lProcessID As Long) As Long

Private Declare Function ProcessFirst Lib "kernel32" Alias _
        "Process32First" (ByVal hSnapShot As Long, uProcess _
        As PROCESSENTRY32) As Long

Private Declare Function ProcessNext Lib "kernel32" Alias _
        "Process32Next" (ByVal hSnapShot As Long, uProcess _
        As PROCESSENTRY32) As Long

Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass _
        As Long)

Const TH32CS_SNAPPROCESS As Long = 2&

Private Type PROCESSENTRY32
  dwSize As Long
  cntUsage As Long
  th32ProcessID As Long
  th32DefaultHeapID As Long
  th32ModuleID As Long
  cntThreads As Long
  th32ParentProcessID As Long
  pcPriClassBase As Long
  dwFlags As Long
  szExeFile As String * MAX_PATH
End Type


Private Sub GetExeNames()
    Dim hSnapShot As Long, Result As Long
    Dim aa As String, bb As String
    Dim Process As PROCESSENTRY32

    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
    If hSnapShot = 0 Then Exit Sub

    Process.dwSize = Len(Process)
    Result = ProcessFirst(hSnapShot, Process)
  
    Do While Result <> 0
        If Process.szExeFile Like "WINWORD.EXE*" Then
            //Process-ID ins Direktfenster ausgeben
            Debug.Print Process.th32ProcessID
        End If
        Result = ProcessNext(hSnapShot, Process)
    Loop
    Call CloseHandle(hSnapShot)
End Sub

Unterformular aus Acces in ein schon geöffnetes Word Dokument übergeben

edgar113

Grünschnabel

Yaslaw

alter Rempler

edgar113

Grünschnabel

Yaslaw

alter Rempler

edgar113

Grünschnabel

Yaslaw

alter Rempler

Neue Beiträge