Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

TransferSpreadsheet - can starting cell be specified?

Status
Not open for further replies.

Doraemon

IS-IT--Management
Sep 12, 2003
31
HK
I am trying to export data from a query to an excel file. The following codes work fine.
But, I would like to ask is it possible for the system to start writing data to cell A13 instead of A1?

Private Sub cmd_export2_Click()
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "q_statistics_form", "C:\temp\testing\Data.xls", True
End Sub

Thanks for your help in advance.
 
TransferSpreadsheet only accepts a range for imports. Strange isn't it. Automation is the way to go:

Code:
Function OutputToSpreadsheet(ByVal strFile As String, _
                             ByVal intSheet As Integer, _
                             ByVal strTable As String, _
                             ByVal strStartCell As String) As Long
On Error GoTo ErrHandler
  
  'Excel stuff
  Dim xl As Excel.Application
  Dim wb As Excel.Workbook
  Dim sht As Excel.Worksheet
  Dim rng As Excel.Range
  Dim lngRow As Long
  Dim lngCol As Long
  
  'Table stuff
  Dim rst As Recordset
  
  If Dir(strFile) = "" Then
    GoTo ExitHere
  End If
  
  Set rst = CurrentDb.OpenRecordset(strTable)
  
  If rst.RecordCount > 0 Then
    
    Set xl = New Excel.Application
    Set wb = xl.Workbooks.Open(strFile, Editable:=True, AddToMru:=False)
    Set sht = wb.Sheets(intSheet)
    
    'Get Row and Column indexes
    lngRow = sht.Range(strStartCell).row
    lngCol = sht.Range(strStartCell).Column
    
    sht.Activate
    
    'If header cells exist, increment row number or
    'add header row dynamically using rst.Fields(x).Name.
    
    'This example doesn't include header row.
    Set rng = sht.Range(sht.Cells(lngRow, lngCol), sht.Cells(lngRow, lngCol + rst.Fields.Count - 1))
    
    'Must have blank adjacent rows to prevent selecting other cells
    rng.CurrentRegion.Select
    
    'Clear old data
    xl.Selection.Clear
    
    'Insert new data
    rng.CopyFromRecordset rst
    
    'Remove region selection
    sht.Range("A1").Select
  
  End If

  'Return total records exported
  OutputToSpreadsheet = rst.RecordCount
    
ExitHere:
  On Error Resume Next
  wb.Close True
  xl.Quit
  Set rng = Nothing
  Set sht = Nothing
  Set wb = Nothing
  Set xl = Nothing
  Exit Function
ErrHandler:
  MsgBox "Error: " & Err & " - " & Err.Description
  Resume ExitHere
End Function


VBSlammer
redinvader3walking.gif

[sleeping]Unemployed in Houston, Texas
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top