Tip

Speed up exports to Excel

View member feedback to this tip.

Use this code to speed up exports to Excel by using the clipboard and pasting the results to Excel, rather than dealing with each cell. (Note: This is specific to our company's address book. You will have to change the database name and the view/column names.)

Code:

Declare Function 
EmptyClipboard Lib "User32" 
() As Long
Declare Function lstrcpy Lib 
"kernel32" (Byval lpString1 As String, 
Byval 
lpString2 As Long) As Long
Declare Function lstrcpy1 Lib 
"kernel32" Alias "lstrcpy" 
(Byval lpString1 As
Long, Byval lpString2 As String) As Long
Declare Function SetClipboardData Lib 
"User32" (Byval wFormat As Long, Byval
hMem As Long) As Long
Declare Function OpenClipboard Lib
 "User32" (Byval hwnd As Long) As Long
Declare Function CloseClipboard Lib
 "User32" () As Long
Declare Function GetClipboardData Lib
 "User32" (Byval wFormat As Long) As Long
Declare Function GlobalAlloc Lib 
"kernel32" (Byval wFlags&, Byval dwBytes As
Long) As Long
Declare Function GlobalLock Lib 
"kernel32" (Byval hMem As Long) As Long
Declare Function GlobalUnlock Lib
 "kernel32" (Byval hMem As Long) As Long
Declare Function GlobalSize Lib 
"kernel32" (Byval hMem As Long) As Long

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Sub Initialize
 Dim fn As String
 Dim ssn As New NotesSession
 Dim db As NotesDatabase
 Dim docs As NotesView
 Dim Doc As NotesDocument
 Dim xlapp As Variant
 Dim RowNo As Integer
 Dim PasteStr As String
 Dim vbTab As String
 Dim pasterow As Integer
 Dim tmpName As Notesname
 
 vbTab = Chr$(9)
 
 Set xlApp = CreateObject
("Excel.application")
 xlApp.Visible = False
 xlApp.Workbooks.Add
 
 PasteStr = "Person" & vbtab & 
 "Last Name" & vbtab &  "First Name" & 
vbtab &  _
 "Department" & vbtab &  "Position #"
 & vbtab &  "Position Name" & vbtab
&  "Service Area" & vbtab &  _
 "Office Phone" & vbtab &  "Direct Line" 
& vbtab &  "Cell Phone" & vbtab 
&  "Home Phone" & vbtab & _
 "Notes Name" &  vbtab &  
"Internet Address"& vbtab & 
"Office" & vbtab
 setclipboardtext (pasteStr)
 RowNo = 1
 xlApp.cells(RowNo,1).pastespecial
 
 Set ssn = New NotesSession
 Set db = ssn.CurrentDatabase
' This is an alias for the 
MNP Team/admin view 
 Set docs = db.GetView
("MNP_Administration")
 Set doc = Docs.GetFirstDocument
 pastestr = ""
 pasterow = 2
 Do Until doc Is Nothing
' Do Until RowNo > 10
  If rowno Mod 10 = 0 Then
   Print "Processing record # " 
& rowno & " - " & 
doc.lastname(0) & ", " & 
doc.firstname(0)
  End If
  RowNo = RowNo + 1
' Doing around 4k at a time 
seems to work well. If we get 
much over that the 
overhead of appending to a long
'  string appears to outweigh the
 benefit of the block paste.
  If Len(pastestr) > 4096 Then
   setclipboardtext (pasteStr)
   xlApp.cells(pasterow,1).
pastespecial
   pasterow = rowno
   pastestr = ""
  End If
  Set tmpname = New notesname
(doc.fullname(0))
  pasteStr = pastestr & doc.EmployeeId(0) 
& vbtab & doc.LastName
(0) & vbtab & doc.FirstName(0) 
& vbtab & _
  doc.department(0) & vbtab 
& Left$(doc.JobTitle(0),2) & vbtab &
Mid$(doc.JobTitle(0),6) & vbtab & _
  doc.MNPspecialtyArea(0) 
& vbtab & doc.OfficePhoneNumber(0) & 
vbtab & doc.DirectPhone(0) 
& vbtab & _
  doc.CellPhoneNumber(0) 
& vbtab & doc.PhoneNumber(0) & vbtab  &
tmpName.Abbreviated & vbtab & _
  doc.InternetAddress(0) & vbtab  
& doc.OfficeCity(0) & vbtab & 
Chr$(10) 
  Set doc = Docs.GetNextDocument(doc)
 Loop
 setclipboardtext (pasteStr)
 xlApp.cells(pasterow,1).pastespecial

 xlapp.Rows("1:1").Select
 xlapp.Selection.HorizontalAlignment = 3
   ' xlCenter ??
 xlapp.Selection.WrapText = 1               
 'True ??
 xlapp.Selection.font.fontstyle="Bold"
 xlapp.selection.font.ColorIndex = 27
 With xlapp.selection.borders(7) 
 ' Left Edge
  .Weight = 4          ' xlThick
  .colorindex = 27
       
 End With 
 With xlapp.selection.borders(8) 
 ' Top Edge
  .Weight = 4 
  ' xlThick
  .colorindex = 27

 End With 
 With xlapp.selection.borders(9)  
 ' Bottom Edge
  .Weight = 4 
 ' xlThick
  .colorindex = 27 
    
 End With 
 With xlapp.selection.borders(10) 
        'Right Edge
  .Weight = 4
 ' xlThick
  .colorindex = 27
       
 End With 
 xlapp.selection.interior.ColorIndex = 11
 
 xlApp.Columns("A:Z").Columns.AutoFit
 xlApp.Range("A2").Select
 xlapp.ActiveWindow.FreezePanes = 1

 xlApp.Visible = True
 Set xlapp = Nothing

End Sub

Function SetClipBoardText(MyString 
As String)
 Dim hGlobalMemory As Long, 
lpGlobalMemory As Long
 Dim hClipMemory As Long, X As Long
 hGlobalMemory = GlobalAlloc(GHND, 
Len(MyString) + 1) 
' Allocate movable global memory.
 lpGlobalMemory = GlobalLock
(hGlobalMemory)
' Lock the block to get a far pointer to 
this memory.
 lpGlobalMemory = lstrcpy1
(lpGlobalMemory,MyString) 
' Copy the string to this global memory
 If GlobalUnlock(hGlobalMemory) 
<> 0 Then 
' Unlock the memory.
  Msgbox "Could not unlock 
memory location. Copy aborted."
  Goto SetError
 End If 
 If OpenClipboard(0&) = 0 Then 
' Open the Clipboard to copy data to.
  Msgbox "Could not open the 
Clipboard. Copy aborted."
  Exit Function
 End If 
 X = EmptyClipboard() 
' Clear the Clipboard. 
 hClipMemory = SetClipboardData
(CF_TEXT, hGlobalMemory) 
' Copy the data to the Clipboard 
 
SetError:
 If CloseClipboard() = 0 Then
  Msgbox "Could not close Clipboard."
 End If
End Function

MEMBER FEEDBACK TO THIS TIP

If the comparison here is to copying data row by row using OLE automation, I wonder whether you couldn't get a corresponding speed increase with some way of copying multiple rows at a time via OLE automation? I don't know that it's possible; I just have to wonder.

FYI: This tip should disclose that it is a Windows-only solution.

Andre Guirard

Do you have comments on this tip? Let us know.

This tip was submitted to the SearchDomino.com tip exchange by member Matt Kiazyk. Please let others know how useful it is via the rating scale below. Do you have a useful Notes/Domino tip or code to share? Submit it to our monthly tip contest and you could win a prize and a spot in our Hall of Fame.

This was first published in May 2004

There are Comments. Add yours.

 
TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.