This is rather long, but is used as an example only, I did not trim it down, I simply pasted it here. Use whatever part of it you want, however you want. Copy and paste it into a module in Access, and it will be much easier to read.
====================
' Constants
Private Const XLS_LOCATION As String = "C:\My Documents\Spreadsheets\Vault.xlt"
Private Const XLT_LOCATION As String = "C:\Windows\Vault.xlt"
Private Const MC_START_ROW As Integer = 299
Private Const MC_END_ROW As Integer = 100
Private Const VISA_START_ROW As Integer = 999
Private Const VISA_END_ROW As Integer = 800
Public Sub populateExcel()
On Error GoTo Populate_Err
Dim rs As Recordset
Dim objXL As Object, objSheet As Object, objRange As Object
Dim strSaveAs As String, strVISA As String, strMC As String
Dim x As Integer, intRow As Integer
DoCmd.Hourglass True
' Set the SQL strings for the two recordsets that will be opened
strVISA = "SELECT CardStyle, StartInv FROM WorkingInvStart WHERE PlasticType = 'VISA'"
strMC = "SELECT CardStyle, StartInv FROM WorkingInvStart WHERE PlasticType = 'MC'"
' Open, and make visible the Excel Template (Vault.xlt) which resides on the desktop
Set objXL = GetObject(XLT_LOCATION)
objXL.Application.Visible = True
objXL.Parent.windows(1).Visible = True
' Open the VISA recordset, and activate the VISA sheet in the template
Set rs = CurrentDb.OpenRecordset(strVISA, dbOpenSnapshot)
Set objSheet = objXL.Worksheets("Visa"
objSheet.Activate
rs.MoveFirst
x = 4
' Insert the data from the VISA recordset into the VISA worksheet
Do Until rs.EOF
objXL.ActiveSheet.Cells(x, 1).Value = rs!CardStyle
objXL.ActiveSheet.Cells(x, 2).Value = rs!StartInv
x = x + 1
rs.MoveNext
Loop
' Delete all unnecessary rows making the VISA worksheet only as long as it needs to be
intRow = VISA_START_ROW
With objSheet
.select
Do Until intRow = VISA_END_ROW
If .Range("A" & intRow).Value = "" Then
Set objRange = .Range("A" & intRow & ":B" & intRow & ":C" & intRow & "
" & intRow & ":E" & intRow _
& ":F" & intRow & ":G" & intRow & ":H" & intRow & ":I" & intRow & ":J" & intRow _
& ":K" & intRow & ":L" & intRow & ":M" & intRow & ":N" & intRow & ":O" & intRow & "
" & intRow)
objRange.Delete 'Shift:=objXLUp
End If
intRow = intRow - 1
Loop
End With
rs.Close
' Open the MC recordset, and activate the MC sheet in the template
Set rs = CurrentDb.OpenRecordset(strMC, dbOpenSnapshot)
Set objSheet = objXL.Worksheets("MC"
objSheet.Activate
rs.MoveFirst
x = 4
' Insert the data from the MC recordset into the MC worksheet
Do Until rs.EOF
objXL.ActiveSheet.Cells(x, 1).Value = rs!CardStyle
objXL.ActiveSheet.Cells(x, 2).Value = rs!StartInv
x = x + 1
rs.MoveNext
Loop
' Delete all unnecessary rows making the MC worksheet only as long as it needs to be
intRow = MC_START_ROW
With objSheet
.select
Do Until intRow = MC_END_ROW
If .Range("A" & intRow).Value = "" Then
Set objRange = .Range("A" & intRow & ":B" & intRow & ":C" & intRow & "
" & intRow & ":E" & intRow _
& ":F" & intRow & ":G" & intRow & ":H" & intRow & ":I" & intRow & ":J" & intRow _
& ":K" & intRow & ":L" & intRow & ":M" & intRow & ":N" & intRow & ":O" & intRow & "
" & intRow)
objRange.Delete
End If
intRow = intRow - 1
Loop
End With
' Calculate totals on spreadsheet
objXL.Application.calculate
' Set the save string, and save the spreadsheet
strSaveAs = "C:\Windows\Desktop\" & Format(DATE, "mmddyyyy"
& ".xls"
objXL.SaveCopyAs strSaveAs
' Quit Excel
objXL.Application.DisplayAlerts = False
objXL.Application.Quit
Set objXL = Nothing
Set objSheet = Nothing
Set objRange = Nothing
Set rs = Nothing
Populate_Exit:
DoCmd.Hourglass False
Exit Sub
Populate_Err:
MsgBox Err.Number & ": " & Err.Description
GoTo Populate_Exit
End Sub
==================== Jim Lunde
compugeeks@hotmail.com
We all agree your theory is crazy, but is it crazy enough?
)
