I have the code below that I got off of the Sandbox sample code and it works great EXCEPT for the following error: Error 101 occurred while creating a text file for output, execution aborted.
What happens is when the action button is clicked, the view is exported directly to Excel, however, if you try to reclick the button and have the new Excel file open the error occurs. Any ideas on how to fix this? I’m guessing this is because it is opening the Excel file with the view name and won’t overwrite the open file.
Thanks in advance!
CODE:
Sub Initialize
Dim workspace As NotesUIWorkspace
Dim uiview As NotesUIView
Dim view As NotesView
Dim column As NotesViewColumn
Dim viewentries As NotesViewEntryCollection
Dim viewnav As NotesViewNavigator
Dim viewentry As NotesViewEntry
Dim session As NotesSession
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim entryvalues As Variant, handle As Variant, wbook As Variant, wsheet As Variant, viewcolumns As Variant
Dim currententry As String, currentprocess As String, viewname As String, filename As String
Dim columnheadings As String, columnvalues As String, columntitle As String
Dim counter As Integer, x As Integer, y As Integer ,slashpos As Integer, spacepos As Integer
Dim hyphenpos As Integer, filenum As Integer, mycounter As Integer, commapos As Integer
On Error Goto processerror
'set objects
currentprocess = "setting objects"
Set workspace = New NotesUIWorkspace
Set uiview = workspace.CurrentView
Set view = uiview.View
Set viewnav = view.CreateViewNav()
Set session = New NotesSession
Set db = session.CurrentDatabase
'get the current view’s name and replace all backslashes with a hyphen
currentprocess = "getting the view name and replacing backslashes with hyphens"
viewname = view.Name
slashpos = Instr(viewname, "\")
If slashpos > 0 Then
Do While slashpos > 0
Mid(viewname, slashpos) = "-"
slashpos = Instr(viewname, "\")
Loop
End If
'now replace all forward slashes with a hyphen
currentprocess = "replacing all forward slashes in the view name with hyphens"
slashpos = Instr(viewname, "/")
If slashpos > 0 Then
Do While slashpos > 0
Mid(viewname, slashpos) = "-"
slashpos = Instr(viewname, "/")
Loop
End If
'reduce view name to a maximum of 31 characters but keep whole words only (cut at first space or hyphen encountered)
currentprocess = "truncating the view name to 31 characters (whole words only)"
If Len(viewname) > 31 Then
viewname = Right(viewname, 31)
spacepos = Instr(viewname, " ")
hyphenpos = Instr(viewname, "-")
If spacepos < hyphenpos Then
viewname = Right(viewname, Len(viewname) - spacepos)
Else
viewname = Right(viewname, Len(viewname) - hyphenpos)
End If
End If
'collect the selected documents
currentprocess = "collecting the selected documents"
Set dc = db.UnprocessedDocuments
'check that documents have been selected at all
currentprocess = "checking that documents were selected at all"
If dc.count = 0 Then
Msgbox "You must select the documents you wish to export. Press CTRL+A to select all documents", 0 + 48, "Error !"
Exit Sub
End If
'if documents have been selected create text file
currentprocess = "creating a text file for output"
filenum = Freefile()
filename = "c:\" & viewname & ".csv"
Open filename For Output As filenum
'create header row in text file
currentprocess = "recreating the column names as header in the text file"
viewcolumns = view.Columns
Set column = viewcolumns(Lbound(viewcolumns))
columnheadings = column.Title
For x = (Lbound(viewcolumns) + 1) To Ubound(viewcolumns)
Set column = viewcolumns(x)
columnheadings = columnheadings & "," & column.Title
Next
Print #filenum, columnheadings
'access each selected document in turn
currentprocess = "starting to process each document in turn"
Set doc = dc.GetFirstDocument
mycounter = 0
counter = 1
Do
counter = counter + 1
currentprocess = "accessing the view entry corresponding to the current document"
'get the view entry corresponding to the current selected document
Set viewentry = viewnav.GetEntry(doc)
If viewentry Is Nothing Then
Print #filenum, "Document ID " & doc.UniversalID & _
" appears under multiple categories. Unable to export, please transfer the data manually."
Else
Redim entryvalues(0)
entryvalues = viewentry.ColumnValues
If Isarray(entryvalues) Then
currentprocess = "creating each column value in its respective cell"
'create each column value in its respective cell
columnvalues = entryvalues(Lbound(entryvalues))
For y = (Lbound(entryvalues)+1) To Ubound(entryvalues)
currentprocess = "replacing any comma in the entry with a semicolon"
'seek and replace commas in entry
currententry = entryvalues(y)
commapos = Instr(currententry, ",")
If commapos > 0 Then
Do While commapos > 0
Mid(currententry, commapos) = ";"
commapos = Instr(currententry, ",")
Loop
entryvalues(y) = currententry
End If
columnvalues = columnvalues & "," & entryvalues(y)
Next
currentprocess = "writing the current view entry to the file"
Print #filenum, columnvalues
End If
End If
'reporting how many documents of how many in total have been exported so far
currentprocess = "reporting progress in status bar"
mycounter = mycounter + 1
Print "Exporting " & Cstr(mycounter) & "/" & dc.Count & " documents."
currentprocess = "accessing the next selected document in the list"
'get the next selected document
Set doc = dc.GetNextDocument(doc)
Loop Until (doc Is Nothing)
currentprocess = "closing the file"
Close filenum
'create Excel sheet
currentprocess = "creating an Excel spreadsheet"
Set handle = CreateObject("Excel.Application")
handle.visible = True
handle.Workbooks.Open(filename)
Set wsheet = handle.Application.Workbooks(1).Worksheets(1)
'format spreadsheet
currentprocess = "formatting the spreadsheet"
wsheet.Name = viewname
wsheet.Cells.Font.Size = 8
wsheet.Rows("1:1").Select
wsheet.Rows("1:1").Font.Bold = True
wsheet.Cells.EntireColumn.Autofit
'return to cell A1 for tidyness
wsheet.Range("A1").Select
currentprocess = "terminating the export job"
Exit Sub
processerror:
If Err = 208 Then
Msgbox "It appears you do not have Microsoft Excel on your computer. Although they won't be displayed on screen the exported data are still available in filename, 0 + 64, Warning !"
Else
Msgbox "Error " & Err & " occurred while " & currentprocess & ", execution aborted.", 0 + 48, "Error !"
End If
Exit Sub
End Sub