[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Getting the field value from Excel

Posted on 2007-10-02
6
Medium Priority
?
342 Views
Last Modified: 2013-12-18
Hi All,

There's a database with lots of (editable) field to fill out. I could gain the values from an Excel table which is already exist.
Is that possible to do it?
0
Comment
Question by:verto33
5 Comments
 
LVL 22

Accepted Solution

by:
mbonaci earned 180 total points
ID: 19997450
'-------------------------------------------------------------
' General
'-------------------------------------------------------------
Const EXCEL_APPLICATION = "Excel.application"

'-------------------------------------------------------------
' Errors
'-------------------------------------------------------------
Private Const BASEERROR = 1200

'-------------------------------------------------------------
' Version Information
'-------------------------------------------------------------
Const REG_97            = "Software\\Microsoft\\Office\\8.0\\Common\\InstallRoot"
Const REG_2000      = "Software\\Microsoft\\Office\\9.0\\Common\\InstallRoot"
Const REG_XP            = "Software\\Microsoft\\Office\\10.0\\Common\\InstallRoot"
Const REG_2003      = "Software\\Microsoft\\Office\\11.0\\Common\\InstallRoot"

Const NAME_97      = "Office 97"
Const NAME_2000      = "Office 2000"
Const NAME_XP      = "Office XP"
Const NAME_2003      = "Office 2003"

'==================================================================================================
' Excel Report
'==================================================================================================
Class ExcelReport
      
      Private xlApp As Variant
      
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' constructor
'
' filepath            path of the excel file - if empty opens an empty excel file
' isVisible            is the excel sheet visible immediately
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      Sub new(filepath As String, isVisible As Boolean)
            Set xlApp = CreateObject(EXCEL_APPLICATION)
            xlApp.Workbooks.Add filepath
            xlApp.Visible = isVisible
      End Sub
      
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' save file
'
' filepath            path, where the file shall be saved
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      Public Function saveAs(filepath As String)
            xlApp.ActiveWorkbook.SaveAs( filepath )
      End Function
      
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' set value in a cell
'
' Sheet                  string or number of sheet in excel file
' row                        row of the cell
' column            column name or number of the cell
' value                  value, which is written into the cell
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++      
      Public Function setCell( Sheet As Variant , row As Integer , column As Variant , value As String )
            xlApp.Workbooks(1).Worksheets( Sheet ).Cells( row , column ).Value = value
      End Function
      
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' get value from a cell
'
' Sheet                  string or number of sheet in excel file
' row                        row of the cell
' column            string or number of the column of the cell
'
' Returns:            value in the cell
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      Public Function getCell( Sheet As Variant , row As Integer , column As Variant ) As String
            On Error Goto GeneralError
            getCell = xlApp.Workbooks(1).Worksheets( Sheet ).Cells( row , column ).Value
            Goto ExitSub
            
GeneralError:
            getCell = ""
            Resume ExitSub
            
ExitSub:
            
      End Function
      
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' quit excel
'
' This must be done at the end, when you are using Excel with visibility=false all the
' time (especially in error handling). Otherwise Excel processes will remain active.
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      Public Function quit
            xlApp.Quit
            Set xlApp = Nothing
      End Function
      
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' set visibility
'
' isVisible            set the visibility to true or false
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      Public Function setVisibility(isVisible As Boolean)
            If (isVisible And Not xlApp.Visible) Then xlApp.Visible = True
            If (Not isVisible And xlApp.Visible) Then       xlApp.Visible = False
      End Function
      
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' get version
'
' Reads the current version of excel from the windows registry (windows only).
' Constants above can be adapted if necessary (e.g. new Office Version).
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      Public Function getVersion() As String
            
            On Error Goto GeneralError
            
            Dim formula As String
            Dim SWVersion As String
            Dim Versions List As String
            Dim v As Variant
            
            '----------------------------------------------------------------------
            ' Initialize all possible versions
            '----------------------------------------------------------------------
            Versions(NAME_97) = REG_97
            Versions(NAME_2000) = REG_2000
            Versions(NAME_XP) = REG_XP
            Versions(NAME_2003) = REG_2003
            
            '----------------------------------------------------------------------
            ' test for installed version
            '----------------------------------------------------------------------
            Forall vers In Versions
                  formula$ = | (@RegQueryValue("HKEY_LOCAL_MACHINE"; "| & vers & |";"Path")) |
                  v = Evaluate( formula$ )
                  If v(0) <> "" Then
                        getVersion = Listtag(vers)
                        Goto ExitSub
                  End If
            End Forall
            
            getVersion = ""
            
            Goto ExitSub
            
GeneralError:
            
            getVersion = ""
            Resume ExitSub
            
ExitSub:
End Function
      
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' export a complete NotesView
'
' This exports the column values of all documents in a view (somehow like the export
' menu of the Lotus Notes client).
'
' view                              view to be exported
' Sheet                              Sheet, where the values will be created in
' OffsetRow                  number of rows, which remain empty at the top
' OffsetCol                        number of columns, which will remainn empty on the left side
' isWithheader            export view headers yes/no
' includeIcons            export columns where only icons are shown: yes/no
' includeColors            export columns where color values are in: yes/no (not yet implemented)
' includeHidden            export columns whcih are hidden: yes/no
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      Public Function exportNotesView(view As NotesView, Sheet As Variant, OffsetRow As Integer, OffsetCol As Integer, isWithHeader As Boolean, includeIcons As Boolean, includeColors As Boolean, includeHidden As Boolean)
            Dim viewnav As NotesViewNavigator
            Dim entry As NotesViewEntry
            Dim viewcolumns As Variant
            Dim column As Integer
            Dim row As Integer
            Dim rowaddition As Integer
            
            '---------------------------------------------------
            ' Init
            '---------------------------------------------------
            Set viewnav = view.CreateViewNav()
            Set entry = viewnav.GetFirstDocument()
            viewcolumns = view.Columns
            rowaddition = 0
            If OffsetRow < 0 Then OffsetRow = 0
            If OffsetCol < 0 Then OffsetCol = 0
            
            '---------------------------------------------------
            ' create header
            '---------------------------------------------------
            If isWithHeader Then
                  column = OffsetCol + 1
                  Forall vc In viewcolumns
                        Call Me.setCell(Sheet, OffsetRow + 1, column, vc.Title)
                        column = column  + 1
                  End Forall      
                  rowaddition = 1
            End If
            
            '---------------------------------------------------
            ' create rows
            '---------------------------------------------------
            row = OffsetRow + 1 + rowaddition
            While Not (entry Is Nothing)
                  column = OffsetCol + 1
                  Forall cv In entry.ColumnValues
                        If doColumnExport(viewcolumns(column - OffsetCol - 1), includeHidden, IncludeIcons, includeColors) Then 'test whether col should be exported
                              Call Me.setCell(Sheet, row, column, Cstr(cv)) ' write cell
                        End If
                        column = column + 1
                  End Forall
                  row = row + 1
                  Set entry = viewnav.GetNextDocument(entry)
            Wend            
      End Function
      
      Private Function doColumnExport (viewcol As NotesViewColumn, includeHidden As Boolean, IncludeIcons As Boolean, includeColors As Boolean) As Boolean
            Dim isHiddenOK As Boolean
            Dim isIconOK       As Boolean
            Dim isColorOK As Boolean
            
            isHiddenOK = (viewcol.isHidden And IncludeHidden) Or Not viewcol.isHidden
            isIconOK = (viewcol.isIcon And IncludeIcons) Or Not (viewcol.isIcon)
            isColorOK = True
            doColumnExport = isHiddenOK And isIconOK And isColorOK
      End Function
      
End Class
0
 

Author Comment

by:verto33
ID: 19997595
You scare me :-)
Where should I enter all that stuff?
0
 
LVL 19

Assisted Solution

by:madheeswar
madheeswar earned 180 total points
ID: 19997599
Ok...here is the simple code to import from Excel.
Sub Initialize
 Dim FileNum As Integer
 Dim xlFilename As String

 Filenum% = Freefile()
 xlFileName$ = Inputbox("What file name and path? example:H:
\June282001.xls")

 Dim session As New NotesSession
 Dim db As NotesDatabase
 Dim view As NotesView
 Dim doc As NotesDocument
 Set db = session.CurrentDatabase
 Set doc = New NotesDocument(db)
 Dim One As String

 Dim row As Integer
 Dim written As Integer

 '// Next we connect to Excel and
open the file. Then start pulling over the records.
 Dim Excel As Variant
 Dim xlWorkbook As Variant
 Dim xlSheet As Variant
 Print "Connecting to Excel..."
 Set Excel = CreateObject( "Excel.Application.8" )
 Excel.Visible = False '// Don't display the Excel window
 Print "Opening " & xlFilename & "..."
 Excel.Workbooks.Open xlFilename '// Open the Excel file
 Set xlWorkbook = Excel.ActiveWorkbook
 Set xlSheet = xlWorkbook.ActiveSheet

 '// Cycle through the rows of the
Excel file, pulling the data over to Notes
 Goto Records
 Print "Disconnecting from Excel..."
 xlWorkbook.Close False '// Close the Excel file without saving (we
made no changes)
 Excel.Quit '// Close Excel
 Set Excel = Nothing '// Free the memory that we'd used
 Print " " '// Clear the status line


Records:
 row = 0 '// These integers intialize to zero anyway
 written = 0

 Print "Starting import from Excel file..."

 Do While True
Finish:
 With xlSheet
 row = row + 1
 Set view = db.GetView("Main View")
 Set doc = db.CreateDocument '// Create a new doc
 doc.Form = "ImportForm1"

 If .Cells (row, 1).Value = "" And .Cells(row,2).Value = ""
And .Cells (row, 3).Value = "" And .Cells(row,4).Value = "" And .Cells
(row, 5).Value = "" And .Cells(row,6).Value = "" And .Cells (row, 7).Value
= "" And .Cells(row,8).Value = "" And .Cells (row, 9).Value = "" And
.Cells(row,10).Value = ""Then
 Goto Finish
 End If

 If .Cells (row, 1).Value = "PO #" And .Cells(row,2).Value
= "Order #" And .Cells (row, 3).Value = "Order da" And .Cells(row,4).Value
= "Part #" And .Cells (row, 5).Value = "Or" And .Cells(row,6).Value
= "Line " And .Cells (row, 7).Value = "Qty" And .Cells(row,8).Value
= "Unit pri" And .Cells (row, 9).Value = "Ship to Company" And
.Cells(row,10).Value = "Ship method"Then
 Goto Finish
 End If


 doc.SWEPO = .Cells( row, 1 ).Value
 doc.SWEORDER = .Cells(row, 2 ).Value
 doc.SWEORDERDATE = .Cells(row, 3).Value
 doc.ITEMNUMBER = .Cells( row, 4 ).Value
 doc.ORDERSTATUS = .Cells(row, 5).Value
 doc.QUANTITYORDERED = .Cells( row, 6).Value
 doc.AMOUNTBILLED = .Cells(row, 7).Value
 doc.SHIPMETHOD = .Cells( row, 8).Value
 doc.SHIPDATE = .Cells(row, 9).Value
 doc.TRACKINGNUMBER = .Cells(row, 10).Value


 Call doc.Save( True, True ) '// Save the new doc

 written = written + 1
 Print written
 If written = 5 Then
 Print written
 Goto Finish
 Else
 Print written
 Messagebox "Finished"
 Goto Done
 End If
 End With
 Loop
 Return
Done:
End Sub
0
 
LVL 22

Expert Comment

by:mbonaci
ID: 19998218
It's a class. Use it like any other product class (e.g. NotesDocument) with its properties and methods.

I got it from here, where you can find the explanation and usage example:

http://www.openntf.org/Projects/codebin/codebin.nsf/CodeSearch/C55558FC7E187C2786256FD50076B2C3
0
 
LVL 1

Expert Comment

by:Computer101
ID: 20295840
Forced accept.

Computer101
EE Admin
0

Featured Post

[Webinar] Cloud and Mobile-First Strategy

Maybe you’ve fully adopted the cloud since the beginning. Or maybe you started with on-prem resources but are pursuing a “cloud and mobile first” strategy. Getting to that end state has its challenges. Discover how to build out a 100% cloud and mobile IT strategy in this webinar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

For Desktop Techs: How to retain a user's Notes configuration data when swapping out the end user's computer. (Assuming that you are not upgrading to a completely different version of Notes client) All you need to do is: 1) install Notes o…
Problem "Can you help me recover my changes?  I double-clicked the attachment, made changes, and then hit Save before closing it.  But when I try to re-open it, my changes are missing!"    Solution This solution opens the Outlook Secure Temp Fold…
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calcul…
As many of you are aware about Scanpst.exe utility which is owned by Microsoft itself to repair inaccessible or damaged PST files, but the question is do you really think Scanpst.exe is capable to repair all sorts of PST related corruption issues?
Suggested Courses

873 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question