LotusScript en Excel import van tekst bestand

Om 12000 documenten te exporteren naar Excel was een LotusScript agent te lang bezig met het vullen van de cellen. Daarom is er gekozen om het bestand naar een comma gescheiden bestand weg te schrijven. De klant vond het echter lastig om dit weer te openen in Excel, vandaar dat er een stukje code moest komen om dit te automatiseren. Een stukje van de code: Sub Initialize Dim OfficeApplication As Variant Dim workbook As Variant Dim xlsheet As Variant Dim ar() As Integer Const xlNone = -4142 Const xlAutomatic = -4105 Const xlUnderlineStyleNone = -4142 Const xlThemeFontNone = -4142 Const xlInsertDeleteCells = 1 Const xlDelimited = 1 Const xlTextQualifierDoubleQuote = 1 Const xlTextFormat = 2 ….. declareer dingen … fList(“Form”) = “Form” …. etc… Set ws = New NotesUIWorkspace filenames = ws.SaveFileDialog(False,”File name”,, “c:\”, “export” & Format(Today,”ddmmyyyy”) & “.txt”) If (Isempty(filenames)) Then Exit Sub End If Set curDB = Session.CurrentDatabase Set View = curDB.GetView(“myView”) View.AutoUpdate = False fileNum% = Freefile() Open filenames(0) For Output As fileNum% Forall i In fList mString$ = mString$ & “,” & i End Forall Print #fileNum%, Strright(mString$,”,”) Set Doc = View.GetFirstDocument Do Until Doc Is Nothing mString$ = “” Forall i In fList If Doc.HasItem(Listtag(i)) Then Set item = Doc.GetFirstItem(Listtag(i)) Select Case item.Type Case 768 mString$ = mString$ & “,” & Replace(Doc.GetFirstItem(Listtag(i)).Text,”,”,”.”) Case 1024 mString$ = mString$ & “,” & Replace(Format(item.Values(0),”dd-mm-yyyy”),”-“,”/”) Case Else mString$ = mString$ & “,” & Replace(Doc.GetFirstItem(Listtag(i)).Text,”,”,”;”) End Select Else mString$ = mString$ & “,” End If End Forall Print #fileNum%, Strright(mString$,”,”) Set Doc = View.GetNextDocument(Doc) Loop Close fileNum% con = “TEXT;” & filenames(0) If Not (setOfficeApplication(“Excel.application”)) Then Exit Sub ‘ start Excel met een functie rgbColor& = xlNone x = 0 Forall i In fList Redim Preserve ar(x) As Integer ar(x) = xlTextFormat x = x + 1 End Forall Set workbook = OfficeApplication.Workbooks.Add () Set xlsheet = OfficeApplication.Workbooks(1).Worksheets(1) With xlsheet.QueryTables.Add(con,xlsheet.Range(“A1″) ) .Name = Strright( filenames(0),”\”) .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 1252 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = ar .TextFileTrailingMinusNumbers = True .Refresh End With ExcelClose: On Error Resume Next OfficeApplication.Cells.EntireColumn.Autofit OfficeApplication.Rows(“1:1″).Select OfficeApplication.Selection.AutoFilter OfficeApplication.Visible = True Exit Sub ErrorHandler: Msgbox Lsi_info(2) & ” ” & Error & lees meer…

Lees verder ...