hier noch mal der aktuelle Stand
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim rtitem As NotesRichTextItem, SendRtitem As NotesRichTextItem
Dim itemReaders As NotesItem, itemReaders2 As NotesItem
Dim object As NotesEmbeddedObject
Dim row As Integer, written As Integer ,iWCount As Integer
Dim colsum As Currency, colsum2 As Currency, colval As Currency, colname As Currency
Dim Excel As Variant, xlWorkbook As Variant, xlSheet As Variant, vIntLeser(3) As Variant
Dim One As String, xlFilename As String
Dim cRechname As String, cPathname As String
Dim tmpKundennr As String
Dim vdoc As NotesDocument
Dim i As String
Dim filenum As Integer
Dim pathName As String
Dim cFilename As String
Dim PathFileName As String
pathName$ = "E:\TestKUR\Excel\*"
cFilename$ = Dir$(pathName$ & "*.xls", 0)
PathFileName = "E:\TestKUR\Excel\" & cFilename$
iWCount = 1
Set db = session.CurrentDatabase
Set Excel = CreateObject( "Excel.Application" )
' *** ---------------------- öffnet Excel File ---------------------------
Excel.Visible = False
Excel.Workbooks.Open PathFileName
Set xlWorkbook = Excel.ActiveWorkbook
'Set xlSheet = xlWorkbook.Worksheets(1)
' *** Einzelverbindungsnachweis: Liest die relevanten Felder aus Zeile 2, erstellt ein Dokument und verschickt ein Mail mit Doclink
Set xlSheet = xlWorkbook.ActiveSheet ' *** Nur ein Sheet - wird hier definiert
row = 2
With xlSheet
tmpKundennr = .Cells( row, 1 ).Value
Set view = db.GetView ("vwKundennummer")
Set vdoc = view.GetDocumentByKey(tmpKundennr)
While Not (vdoc Is Nothing)
tmpKundennr = .Cells( row, 1 ).Value
Set vdoc = view.GetDocumentByKey(tmpKundennr)
vdoc.Form = "maKundenetikett"
vdoc.fdLayout1 = .Cells( row, 2 ).Value
vdoc.fdLayout2 = .Cells( row, 3 ).Value
vdoc.fdLayout_Ende = .Cells( row, 4 ).Value
vdoc.fdPLPA = .Cells( row, 5 ).Value
vdoc.fdFSPS = .Cells( row, 6 ).Value
vdoc.fdPUNr = .Cells( row, 7 ).Value
Call vdoc.save(False,True)
row = row + 1
' tmpKundennr = .Cells( row, 1 ).Value
' Set vdoc = view.GetDocumentByKey(tmpKundennr)
Wend
End With
NextDoc:
' *** Disconnecting from Excel...
xlWorkbook.Close False
Excel.Quit
Set Excel = Nothing
EndeAlles:
'Exit Sub
End Sub
