Modifying Bob Larson’s code… his code works fine, but I would like to modify this code a little so I can export to sheet2 of a specific “named excel file” so I can link certain sheet1 cells to the sheet2 cells I just exported in from access. Can someone help me on what to modify in the code below?
' Procedure : Send2Excel
' Author : Bob Larson
' Date : 5/25/2008
' Purpose : Send any single recordset form to Excel. This will not work with
' subforms.
' Use : You may freely use this code as long as the author information in
' this header remains intact
'---------------------------------------------------------------------------------------
'
Public Function Send2Excel(frm As Form, Optional strSheetName As String)
' frm is the name of the form you want to send to Excel
' strSheetName is the name of the sheet you want to name it to
Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim intCount As Integer
Dim strReportTemplate As String
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
On Error GoTo err_handler
Set rst = frm.RecordsetClone
strReportTemplate = "C:\Documents and Settings\ne33214\Desktop\SAS Form CP_07_02_01.xls"
' Set ApXL = CreateObject("Excel.Application")
' Set xlWBk = ApXL.Workbooks.Add
' ApXL.Visible = True
Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(strSheetName) > 0 Then
xlWSh.Name = Left(strSheetName, 34)
End If
xlWSh.Range("A1").Select
Do Until intCount = rst.Fields.Count
ApXL.ActiveCell = rst.Fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:1").Select
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select
rst.Close
Set rst = Nothing
Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Exit Function
End Function
' Procedure : Send2Excel
' Author : Bob Larson
' Date : 5/25/2008
' Purpose : Send any single recordset form to Excel. This will not work with
' subforms.
' Use : You may freely use this code as long as the author information in
' this header remains intact
'---------------------------------------------------------------------------------------
'
Public Function Send2Excel(frm As Form, Optional strSheetName As String)
' frm is the name of the form you want to send to Excel
' strSheetName is the name of the sheet you want to name it to
Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim intCount As Integer
Dim strReportTemplate As String
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
On Error GoTo err_handler
Set rst = frm.RecordsetClone
strReportTemplate = "C:\Documents and Settings\ne33214\Desktop\SAS Form CP_07_02_01.xls"
' Set ApXL = CreateObject("Excel.Application")
' Set xlWBk = ApXL.Workbooks.Add
' ApXL.Visible = True
Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(strSheetName) > 0 Then
xlWSh.Name = Left(strSheetName, 34)
End If
xlWSh.Range("A1").Select
Do Until intCount = rst.Fields.Count
ApXL.ActiveCell = rst.Fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:1").Select
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select
rst.Close
Set rst = Nothing
Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Exit Function
End Function
