Hallo PieWie,
mach es doch einfach so:
mach es doch einfach so:
Sub CommandButton1_Click()Gruß Uwe
Dim oExcelApp As Object
Dim oExcelWorkbook As Object
Dim lZeile As Long
'Textmarken vorsorglich leeren
ActiveDocument.Bookmarks("Händlername").Range.Text = ""
ActiveDocument.Bookmarks("Händlername2").Range.Text = ""
ActiveDocument.Bookmarks("Händlerstraße").Range.Text = ""
ActiveDocument.Bookmarks("Händlerstraße2").Range.Text = ""
ActiveDocument.Bookmarks("HändlerPLZ").Range.Text = ""
ActiveDocument.Bookmarks("HändlerPLZ2").Range.Text = ""
ActiveDocument.Bookmarks("HändlerOrt").Range.Text = ""
ActiveDocument.Bookmarks("HändlerOrt2").Range.Text = ""
ActiveDocument.Bookmarks("Produkt").Range.Text = ""
ActiveDocument.Bookmarks("Seriennummer").Range.Text = ""
ActiveDocument.Bookmarks("Versanddatum").Range.Text = ""
If ListBox1.ListIndex >= 0 Then
'Zuerst wird die Excel Datei geöffnet
Set oExcelApp = CreateObject("Excel.Application")
Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
lZeile = 2
With oExcelWorkbook.Sheets(sTabellenblatt)
Do While .Cells(lZeile, 1) <> ""
If ListBox1.Text = CStr(.Cells(lZeile, 2).Value) Then
'Eintrag gefunden, Textmarken füllen
ActiveDocument.Bookmarks("Händlername").Range.Text = _
CStr(.Cells(lZeile, 2).Value)
ActiveDocument.Bookmarks("Händlername2").Range.Text = _
CStr(.Cells(lZeile, 2).Value)
ActiveDocument.Bookmarks("Händlerstraße").Range.Text = _
CStr(.Cells(lZeile, 5).Value)
ActiveDocument.Bookmarks("Händlerstraße2").Range.Text = _
CStr(.Cells(lZeile, 5).Value)
ActiveDocument.Bookmarks("HändlerPLZ").Range.Text = _
CStr(.Cells(lZeile, 3).Value)
ActiveDocument.Bookmarks("HändlerPLZ2").Range.Text = _
CStr(.Cells(lZeile, 3).Value)
ActiveDocument.Bookmarks("HändlerOrt").Range.Text = _
CStr(.Cells(lZeile, 4).Value)
ActiveDocument.Bookmarks("HändlerOrt2").Range.Text = _
CStr(.Cells(lZeile, 4).Value)
ActiveDocument.Bookmarks("Produkt").Range.Text = TextBox2.Value
ActiveDocument.Bookmarks("Seriennummer").Range.Text = TextBox1.Value
ActiveDocument.Bookmarks("Versanddatum").Range.Text = TextBox3.Value
Exit Do
End If
lZeile = lZeile + 1
Loop
End With
oExcelWorkbook.Close False
oExcelApp.Quit
Else
MsgBox "Bitte wählen Sie einen Eintrag aus der Liste aus!", _
vbInformation + vbOKOnly, "HINWEIS!"
Exit Sub
End If
Set oExcelWorkbook = Nothing
Set oExcelApp = Nothing
Unload Me
End Sub