Das ist der vollständige Quellcode.
Per Dialogbox werden Suchkriterien abgefragt, der Search wird ausgeführt, count ist <> 0, ein Pfad und ein Name für ein xls-File wird abgefragt und erstellt, die Titelzeile wird eingetragen, ich kriege Nothing zurück und schaue auf ein bis auf die Titelzeile leeres Excel File.
Sub Initialize
Dim ws As New NotesUIWorkspace
'Dim s As New NotesSession
Dim db As NotesDatabase
Dim dlgdoc As NotesDocument
Dim searchstring As String
Dim dt As New NotesDateTime("21.01.1971")
Dim dc As NotesDocumentCollection
Dim dtfrom As NotesDateTime
Dim dtto As NotesDateTime
Dim filename
Dim xlsapp As Variant
Dim xlsdoc As Variant
Dim cr As String
Dim i As Integer
Dim doc As NotesDocument
Dim ndoc As NotesDocument
cr = |
|
Set db = ws.CurrentDatabase.Database
Set dlgdoc = db.CreateDocument
nochmal:
If ws.DialogBox("DlgSearch", True, True, False, False, False, False, "Please define search dates", dlgdoc, False, False, False) Then
If "" = dlgdoc.From(0) Then
Messagebox |From Date must be defined.|, 0, "Mandatory Field"
Goto nochmal
End If
If "" = dlgdoc.To(0) Then
Messagebox |To Date must be defined.|, 0, "Mandatory Field"
Goto nochmal
End If
Set dtfrom = New NotesDateTime(dlgdoc.From(0))
Set dtto = New NotesDateTime(dlgdoc.To(0))
If "" = dlgdoc.ProblemTheme(0) Or " " = dlgdoc.ProblemTheme(0) Then
If "" = dlgdoc.ProblemStatus(0) Or " " = dlgdoc.ProblemStatus(0) Then
searchstring = |Form = "HelpDeskAssign"|+_
| & @TextToNumber(@Left(ProblemID; 8)) >= |+_
Cstr(Year(dtfrom.LSLocalTime))+Right$("00" + Cstr(Month(dtfrom.LSLocalTime)), 2)+Right$("00" + Cstr(Day(dtfrom.LSLocalTime)), 2) +_
| & @TextToNumber(@Left(ProblemID; 8)) <= | +_
Cstr(Year(dtto.LSLocalTime))+Right$("00" + Cstr(Month(dtto.LSLocalTime)), 2)+Right$("00" + Cstr(Day(dtto.LSLocalTime)), 2)
Else
searchstring = |Form = "HelpDeskAssign"|+_
| & @UpperCase(ProblemStatus) = "|+dlgdoc.ProblemStatus(0)+_
|" & @TextToNumber(@Left(ProblemID; 8)) >= |+_
Cstr(Year(dtfrom.LSLocalTime))+Right$("00" + Cstr(Month(dtfrom.LSLocalTime)), 2)+Right$("00" + Cstr(Day(dtfrom.LSLocalTime)), 2) +_
| & @TextToNumber(@Left(ProblemID; 8)) <= | +_
Cstr(Year(dtto.LSLocalTime))+Right$("00" + Cstr(Month(dtto.LSLocalTime)), 2)+Right$("00" + Cstr(Day(dtto.LSLocalTime)), 2)
End If
Else
If "" = dlgdoc.ProblemStatus(0) Or " " = dlgdoc.ProblemStatus(0) Then
searchstring = |Form = "HelpDeskAssign" & ProblemTheme = "|+dlgdoc.ProblemTheme(0)+_
|" & @TextToNumber(@Left(ProblemID; 8)) >= |+_
Cstr(Year(dtfrom.LSLocalTime))+Right$("00" + Cstr(Month(dtfrom.LSLocalTime)), 2)+Right$("00" + Cstr(Day(dtfrom.LSLocalTime)), 2) +_
| & @TextToNumber(@Left(ProblemID; 8)) <= | +_
Cstr(Year(dtto.LSLocalTime))+Right$("00" + Cstr(Month(dtto.LSLocalTime)), 2)+Right$("00" + Cstr(Day(dtto.LSLocalTime)), 2)
Else
searchstring = |Form = "HelpDeskAssign" & ProblemTheme = "|+dlgdoc.ProblemTheme(0)+_
|" & @UpperCase(ProblemStatus) = "|+dlgdoc.ProblemStatus(0)+_
|" & @TextToNumber(@Left(ProblemID; 8)) >= |+_
Cstr(Year(dtfrom.LSLocalTime))+Right$("00" + Cstr(Month(dtfrom.LSLocalTime)), 2)+Right$("00" + Cstr(Day(dtfrom.LSLocalTime)), 2) +_
| & @TextToNumber(@Left(ProblemID; 8)) <= | +_
Cstr(Year(dtto.LSLocalTime))+Right$("00" + Cstr(Month(dtto.LSLocalTime)), 2)+Right$("00" + Cstr(Day(dtto.LSLocalTime)), 2)
End If
End If
Set dc = db.Search(searchstring, dt, 0)
If 0 <> dc.Count Then
filename = ws.OpenFileDialog( False , "please select file" , "Microsoft Excel-files|*.xls" , "" , "" )
If Not(Isempty(filename)) Then
On Error Resume Next
Set xlsapp = GetObject("", "Excel.Application")
If xlsapp Is Nothing Then
Set xlsapp = CreateObject("Excel.Application")
On Error Goto iserror
If Not xlsapp Is Nothing Then
Set xlsdoc = xlsapp.Workbooks.Add
xlsapp.Visible = False
Call xlsdoc.Activate
End If
Else
On Error Goto iserror
Set xlsdoc = xlsapp.Workbooks.Add
xlsapp.Visible = False
Call xlsdoc.Activate
End If
If Not xlsdoc Is Nothing Then
xlsapp.Sheets(1).Select
xlsapp.Range("A1").Select
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column) = "Link"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 1) = "Year"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 2) = "Month"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 3) = "Day"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 4) = "ID"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 5) = "Contributor"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 6) = "Contributor Cost Center"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 7) = "Theme"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 8) = "Application"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 9) = "Responsible"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 10) = "LBR"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 11) = "Subject"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 12) = "Location"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 13) = "Status"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 14) = "Effort spent for Analysis"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 15) = "Effort spent for Realization"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 16) = "Effort spent for Test"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 17) = "Total spent"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 18) = "Total costs"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 19) = "Charge CC"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 20) = "Category"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 21) = "Error Type"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 22) = "Error Origin Group"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 23) = "Error Origin Dept"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 24) = "Requester Group"
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 25) = "Requester Dept"
If dc.Count <> 0 Then
Set doc = dc.GetFirstDocument
While Not doc Is Nothing
Set ndoc = dc.GetNextDocument(doc)
xlsapp.Range("A"+Cstr(i+1)).Select
Call xlsdoc.Worksheets(1).Hyperlinks.Add(xlsapp.Range("A"+Cstr(i+1)), _
"http://svmosel.lux.swissbank.com/LUX/luxsmart.nsf/HelpDeskAssign/"+Cstr(doc.UniversalID)+"?OpenDocument", _
, , _
doc.ProblemID(0))
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 1) = Left$(doc.ProblemID(0), 4)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 2) = Right$(Left$(doc.ProblemID(0), 6), 2)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 3) = Right$(Left$(doc.ProblemID(0), 8), 2)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 4) = doc.ProblemID(0)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 5) = doc.ProblemContributorName(0)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 6) = doc.ProblemContributorCostCenter(0)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 7) = doc.ProblemTheme(0)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 8) = doc.ProblemThemeCategory(0)
If "CLO" = Ucase$(doc.ProblemStatus(0)) Then
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 9) = doc.ProblemLastResponsible(0)
Else
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 9) = doc.ProblemResponsible(0)
End If
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 10) = doc.ProblemLBR(0)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 11) = doc.ProblemSubject(0)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 12) = Join(doc.LocSel, ", ")
If "ASS" = Ucase$(doc.ProblemStatus(0)) Then
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 13) = "Assigned"
Else
If "ACC" = Ucase$(doc.ProblemStatus(0)) Then
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 13) = "Accepted"
Else
If "CLO" = Ucase$(doc.ProblemStatus(0)) Then
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 13) = "Closed"
Else
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 13) = doc.ProblemStatus(0)
End If
End If
End If
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 14) = Cstr(doc.AnalyseEffortDone(0))
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 15) = Cstr(doc.ProblemEffortDone(0))
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 16) = Cstr(doc.TestEffortDone(0))
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 17) = Cstr(doc.TotalEffortSpent(0))
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 18) = Cstr(doc.ProblemCosts(0))
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 19) = doc.ProblemChargeNumber(0)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 20) = doc.ClaimCat(0)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 21) = doc.FehlerArt(0)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 22) = doc.ErrorOriginGroup(0)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 23) = doc.ErrorOriginDept(0)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 24) = doc.RequesterList(0)
xlsdoc.Worksheets(1).cells(xlsapp.activecell.row, xlsapp.activecell.column + 25) = doc.RequesterDept(0)
Set doc = ndoc
Wend
End If
Call xlsdoc.SaveAs(filename(0))
xlsapp.Visible = True
End If
End If
End If
End If
Exit Sub
iserror:
Messagebox "Error" & Str(Err) & ": " & Error$ & cr & "Please contact Administrator.", 48, "Error"
Resume Next
End Sub