Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Writing Data in Excel format

Posted on 1999-07-22
5
Medium Priority
?
238 Views
Last Modified: 2010-04-30
Hi, I have some data that I'd like to write in an Excel spreadsheet directly from my VB program.

Can somebody give me some sample code to add the text in a cell for example?

Thanks
0
Comment
Question by:mikemonnex
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
5 Comments
 
LVL 1

Expert Comment

by:raygibbins
ID: 1526665
Sample Code from CExcel97.cls


VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CExcel97"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' Class       : CExcel97
' Description : Class for working with Microsoft Excel 97 through Automation

Private m_objExcel As Excel.Application
Private m_objWorkbook As Excel.Workbook

Public Property Get AppExcel() As Excel.Application
  ' Returns: A handle to the current instance of Excel
  '
  Set AppExcel = m_objExcel
 
End Property

Public Property Get CurWorkbook() As Excel.Workbook
  ' Returns: A handle to the currently open workbook
 
  Set CurWorkbook = m_objWorkbook
 
End Property

Public Sub CloseExcel()
  ' Comments  : Closes Excel
  ' Parameters: None
  ' Returns   : Nothing
  '
  On Error GoTo PROC_ERR
 
  m_objExcel.Quit
 
  Set m_objExcel = Nothing
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "CloseExcel"
  Resume PROC_EXIT
 
End Sub

Public Sub CloseWorkbook( _
  fSave As Boolean)
  ' Comments  : Closes the current workbook
  ' Parameters: fSave - True to save changes, False to discard changes
  ' Returns   : Nothing
  '
  On Error GoTo PROC_ERR
 
  m_objWorkbook.Close SaveChanges:=fSave
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "CloseWorkbook"
  Resume PROC_EXIT
 
End Sub

Public Sub CreateTableFromAccess( _
  strDatabase As String, _
  strDataSource As String, _
  fFieldNames As Boolean, _
  Optional varMaxRecs As Variant)
  ' Comments  : Gets the contents of an Access table or query into
  '             the current document
  ' Parameters: strDatabse - full path and name of the Access database
  '             you want to read from
  '             strDataSource - name of a table or query in the database
  '             to read records from
  '             fFieldNames - True to put the field names in the first
  '             row, false otherwise.
  '             varMaxRecs - optional: set to the maximum number of
  '             records you want to retrieve. To include all records,
  '             don't specify this argument.
  ' Returns   : Nothing
  '
  Dim dbs As DAO.Database
  Dim rst As DAO.Recordset
  Dim intCounter As Integer
  Dim intFieldCount As Integer
  Dim lngRowCount As Long
  Dim varField As Variant
  Dim intRow As Integer
  Dim intCol As Integer
 
  On Error GoTo PROC_ERR
 
  ' Open the database objects
  Set dbs = DAO.DBEngine.OpenDatabase(strDatabase)
  Set rst = dbs.OpenRecordset(strDataSource)
  intFieldCount = rst.Fields.Count
 
  intRow = 1
  intCol = 1
 
  ' Add the field names if specified
  If fFieldNames Then
    For intCounter = 1 To intFieldCount
      m_objWorkbook.ActiveSheet.Cells(1, intCounter).Value = _
        rst.Fields(intCounter - 1).Name
    Next intCounter
  End If
 
  ' Start inserting data on the second row of the table
  lngRowCount = 2
 
  With rst
    ' Loop through all records
    Do Until .EOF
   
      For intCounter = 1 To intFieldCount
        ' Add each fields value
        varField = .Fields(intCounter - 1).Value
       
        ' Handle null field values
        If IsNull(varField) Then
          varField = "<null>"
        End If
       
        m_objWorkbook.ActiveSheet.Cells(lngRowCount, intCounter).Value = _
          varField
         
      Next intCounter
 
      lngRowCount = lngRowCount + 1
     
      ' See if we are still in range
      If Not IsMissing(varMaxRecs) Then
        If lngRowCount > varMaxRecs Then
          Exit Do
        End If
      End If
     
      ' Move to the next record
      .MoveNext
 
    Loop
  End With
 
  ' Cleanup
  rst.Close
  dbs.Close
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "CreateTableFromAccess"
  Resume PROC_EXIT
 
End Sub

Public Sub CreateWorkbook( _
  strName As String, _
  fSave As Boolean)
  ' Comments  : Creates a new workbook and saves it
  ' Parameters: strName - name for the new workbook
  '             fSave - True to save, False to leave unsaved
  ' Returns   : Nothing
  '
  On Error GoTo PROC_ERR
 
  Set m_objWorkbook = m_objExcel.Workbooks.Add

  m_objWorkbook.SaveAs filename:=strName
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "CreateWorkbook"
  Resume PROC_EXIT
 
End Sub

Public Sub InsertValue( _
  strRange As String, _
  varValue As Variant)
  ' Comments  : Inserts values into cells
  ' Parameters: strRange - string defining the range to insert into
  '             varValue - value to insert
  ' Returns   : Nothing
  '
  On Error GoTo PROC_ERR
 
  m_objWorkbook.ActiveSheet.Range(strRange).Value = varValue
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "InsertValue"
  Resume PROC_EXIT
 
End Sub

Public Sub OpenWorkbook( _
  strFileName As String, _
  fReadOnly As Boolean, _
  Optional varPassword As Variant)
  ' Comments  : Opens the named file and associates it with the class
  ' Parameters: strFileName - full path and name of the file to open
  '             fReadOnly - True to open readonly
  '             varPassword - Optional: specify the password if the
  '             workbook file is password protected.
  ' Returns   : Nothing
  '
  On Error GoTo PROC_ERR
 
  If Not IsMissing(varPassword) Then
    Set m_objWorkbook = m_objExcel.Workbooks.Open( _
      strFileName, _
      , _
      fReadOnly, _
      , _
      varPassword)
  Else
    Set m_objWorkbook = m_objExcel.Workbooks.Open( _
      strFileName, _
      , _
      fReadOnly)
  End If
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "OpenWorkbook"
  Resume PROC_EXIT
 
End Sub

Public Sub OpenWorkbookFromLib( _
  strFileName As String, _
  fReadOnly As Boolean, _
  Optional varPassword As Variant)
  ' Comments  : Opens the named file and associates it with the class.
  '             This version looks in the Excel library folder.
  ' Parameters: strFileName - name of the file to open
  '             fReadOnly - True to open readonly
  '             varPassword - Optional: specify the password if the
  '             workbook file is password protected.
  ' Returns   : Nothing
  '
  Dim strLibPath As String
 
  On Error GoTo PROC_ERR
 
  strLibPath = m_objExcel.LibraryPath & _
    m_objExcel.PathSeparator & _
    strFileName
   
  If Not IsMissing(varPassword) Then
    Set m_objWorkbook = m_objExcel.Workbooks.Open( _
      strLibPath, _
      , _
      fReadOnly, _
      , _
      varPassword)
  Else
    Set m_objWorkbook = m_objExcel.Workbooks.Open( _
      strLibPath, _
      , _
      fReadOnly)
  End If
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "OpenWorkbookFromLib"
  Resume PROC_EXIT
 
End Sub

Public Sub PrintSheet( _
  intFrom As Integer, _
  intTo As Integer, _
  intCopies As Integer, _
  fPreview As Boolean, _
  fPrintToFile As Boolean, _
  fCollate As Boolean)
  ' Comments  : Prints the active workbook
  ' Parameters: intFrom - starting page number
  '             intTo - ending page number
  '             intCopies - number of copies
  '             fPreview - True for print preview
  '             fPrintToFile - True to print to a file. Excel will prompt
  '             for the filename when this is set to True.
  '             fCollate - True to collate copies
  ' Returns   : Nothing
  '
  On Error GoTo PROC_ERR
 
  m_objWorkbook.PrintOut _
    intFrom, _
    intTo, _
    intCopies, _
    fPreview, _
    , _
    fPrintToFile, _
    fCollate
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "PrintSheet"
  Resume PROC_EXIT
   
End Sub

Public Sub SortRange( _
  strRange As String, _
  strKey As String, _
  Optional fAscending As Boolean = False)
  ' Comments  : Sorts the specified range
  ' Parameters: strRange - range to sort
  '             strKey - range to use as the key for sorting
  '             fAscending - True for ascending, False for descending
  ' Returns   : Nothing
  '
  Dim lngSort As Integer
 
  If fAscending Then
    lngSort = xlAscending
  Else
    lngSort = xlDescending
  End If
 
  m_objWorkbook.ActiveSheet.Range(strRange).Sort _
    Key1:=ActiveSheet.Range(strKey), order1:=lngSort
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "SortRange"
  Resume PROC_EXIT
   
End Sub

Public Sub StartExcel(fVisible As Boolean)
  ' Comments  : Starts an instance of Excel
  ' Parameters: fVisible - True to make Excel visible
  ' Returns   : Nothing
  '
  On Error GoTo PROC_ERR
 
  Set m_objExcel = New Excel.Application
  m_objExcel.Visible = fVisible
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "StartExcel"
  Resume PROC_EXIT

End Sub


0
 
LVL 8

Expert Comment

by:vettranger
ID: 1526666
Also, you posted this question 4 times. You need to delete the other three occurences of it.
0
 
LVL 1

Accepted Solution

by:
krush earned 400 total points
ID: 1526667
Dim wkbObj As Workbook

Set wkbObj = GetObject(App.Path & "\BorList.xls")
wkbObj.Worksheets(1).range("A1").Value="Value to be entered"
0
 
LVL 1

Expert Comment

by:krush
ID: 1526668
u may also have to add the Excel 8.0 Object library in the refrences
0
 

Expert Comment

by:vbsmith
ID: 1526669
Wow, that's a lot of code AND it requires Execl automation too!

I don't know if I would have called it the final answer, because actually you can export direct to Excel (or Lotus or xBase or dBase or Text or HTML) and you can convert any of these formats to any other format completely with a single line of DAO or ADO2.1sp2 code.  It will chop a hundreds lines form the accepted answer and bo so much faster you'll be amazed.

MS says you can't but, think about it .. how do they do TransferDatabase?

If you want to see a single line that will do you a lot of good, look at:  

http://www.smithvoice.com/vb5expt.htm

Works with DAO/ADO all  versions of Jet, VB, VC++, Access et all.

-Smith
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

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

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Suggested Courses

661 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