Could anyone offer assistance on modifying this script to populate a table called “LabelsToPrint” in MS Access (c:\labelstoprint.mdb) instead of an Excel file? The attached code (I found it here in the forums) is executed from a view in Notes, and replaces the spreadsheet rows with whatever is currently in the view. Problem is I can’t use a spreadsheet for security reasons, I have to use Access. I’m trying to get a label program to populate a template, but the program can’t see linked tables in Access (I tried this using NotesSQL and ODBC connection), so I need to populate a non-linked table instead. I’m no good at script and don’t have LEI or DECS installed or any of the other add-ins for Notes. I’ve searched all over the web, as well as these forums and the sandbox but could not find anything I could use. Thanks for your time.
Sub Initialize
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim uiview As NotesUIView
Dim view As NotesView
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim xlApp As Variant
Dim xlsheet As Variant
Dim dc As NotesDocumentCollection
Dim numDocs As Long ' number of documents in view
Dim docCount As Long' current doc in view
Dim count As Integer
Dim cols () As String ' array of columns (to be defined once number of visable columns determined)
Dim colName As String
Dim formula As String
Dim itemName As String
Dim itype As String ' type of value retrieved in ival
Dim flag As Variant
Dim flag2 As Variant
Dim ival As Variant ' value retrieved from formula or item
Dim newival As Variant 'value with carriage retuns removed and trimmed
Dim item As notesItem
Dim row As Integer
Dim kr As Integer
Dim kc As Integer
Dim numCols As Integer
Dim xlRange As String
Set db=session.currentdatabase
Set uiview = ws.CurrentView
Set view=uiview.view
Dim collection As NotesDocumentCollection
numCols=-1 ' is -1 because cols array starts at 0
’ find out how many visable non icon columns there are
Forall c In view.Columns
flag = Not c.IsHidden
flag2 = Not c.IsIcon
If flag=True And flag2=True Then numCols=numCols+1
End Forall
If numCols=-1 Then End
Set xlApp = CreateObject("Excel.Application")
xlApp.Workbooks.Open("C:\labelstoprint.xls")
xlApp.Visible = True
Set xlsheet = xlApp.ActiveSheet
xlsheet.cells.Clear
numberOfColumns=numCols+1
Redim cols (numCols,4) As String ' create array
count=-1
Forall c In view.columns
’ is the column visable, if so retrieve item name or formula
flag = Not c.IsHidden
flag2 = Not c.IsIcon
If flag=True And flag2=True Then
count=count+1
cols(count,0)=c.title ' column title
cols(count,3)=Cstr(c.NumberFormat) 'CURRENCY=3, FIXED=1, GENERAL=0, SCIENTIFIC=2
cols(count,4)=Cstr(c.NumberAttrib) ' punctuate thousands #, ###=1
If c.Formula="" Then
cols(count,1)=c.ItemName
Else
cols(count,1)=c.Formula
cols(count,2)="F" ' identify that this column is a formula and not an item
End If
End If
End Forall
xlsheet.cells.Clear
row=1
’ write header
For col=0 To Ubound (cols)
colName=cols(col,0)
If colName="" Then colName="<No Title>"
’ create excel column reference
xlRange=xlApp.cells(row,1+col).Address
’ write data and apply format
xlApp.Range(xlRange).value=colName
’ removed because it was causing large fields not to resize, If cols(col,3) =“0” Then xlApp.Columns(1+col).NumberFormat = “@”
If cols(col,3)="1" And cols(col,4)="1" Then xlApp.Columns(1+col).NumberFormat = "#,##0"
If cols(col,3)="3" Then xlApp.Columns(1+col).NumberFormat = "$#, ##0.00"
Next col
’ Clean up header
xlRange="$A$1:"+xlApp.cells(1, numCols+1).Address
With xlApp
.ActiveWindow.SplitRow = 1
.ActiveWindow.FreezePanes = True ' freeze panes
.Range(xlRange).Font.Bold = True ' set row to bold
.Range(xlRange).Borders.LineStyle=1 ' set border
.Range(xlRange).Borders.Weight=1 ' set weight of border
.Range(xlRange).Interior.ColorIndex = 48
End With
'************************************************************************
’ Set collection = db.AllDocuments
’ Set doc = collection.GetFirstDocument
’ Do Until doc Is Nothing
’ Call uiview.SelectDocument(doc)
’ Set doc=dc.getNextDocument(doc)
’ Loop
'**************************************************************************
Set db=session.currentdatabase
Set uiview = ws.CurrentView
Set view=uiview.view
Set dc=db.unprocesseddocuments
’ write data
Set doc=dc.getFirstDocument
docCount=0
Do Until doc Is Nothing
docCount=docCount+1
row=row+1 ' we are writing to next row
’ write excel row (ival)
For col=0 To Ubound (cols)
’ evaluate formula from doc
ival=""
newival=""
formula=cols(col,1)
eval=Evaluate (formula,doc)
ival=eval
’ create excel column reference
xlRange=xlApp.cells(row,1+col).Address
’ write data
’ step through array to get multivalue fields
Forall z In ival
cnt#=cnt#+1
If cnt#>1 Then
cellval$=cellval$ + "; "+ z
Else
cellval$=z
End If
End Forall
’ remove carriage returns and trim
For x = 1 To Len(cellval$)
y = Mid(cellval$, x, 1)
If y <> Chr(13) Then newcell$= newcell$ & y
Next
newcell$=Trim(newcell$)
’ End If
xlApp.Range(xlRange).value=newcell$
cellval$=""
newcell$=""
cnt#=0
Next col
doc.printflag="1"
Call doc.save(True,False)
Set doc=dc.getNextDocument(doc)
Loop
Set view = db.getview("Cassette Labels to Print")
Call view.refresh
Call uiview.deselectAll()
Call ws.viewrefresh
’ Clean up worksheet
numberOfColumns=numCols+1
For x=1 To numberOfColumns
xlApp.Columns(x).Font.Size=8
xlApp.Columns(x).VerticalAlignment =-4160 ' xlTop
xlApp.Columns(x).AutoFit
xlApp.Columns(x).WrapText = True
If xlApp.Columns(x).ColumnWidth > 100 Then xlApp.Columns(x).ColumnWidth = 100
Next x
'xlApp.ActiveWorkbook.SaveAs FileName , 24, True
'xlApp.Application.DisplayAlerts = False
'xlWorkbooks.Close True
'xlApp.Quit
'Set xlApp = Nothing
End Sub