Hello. I have an Excel template where I need to export data from an
Access database (version 2003). I have the following code
working .... somewhat. There are 294 records to export but when it
gets to Excel only 98 records are visible. I suspect it has to do
with the fact that there are merged cells in the template I am
exporting to. When arrowing down through the spreadsheet cells go
from B12 (B12 is B12, B13 and B14 merged together) to B15 to B18,
etc. I tried to figure out if there was a way to adjust the code to
compensate for the merged rows. Any help would be appreciated.

On Error GoTo ErrorHandler
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strTemplateDir As String
Dim strCaseNumber As String
Dim strSeqNum As String
Dim strLname As String
Dim strFname As String
Dim strDOB As String
Dim lngCount As Long
Dim strEmpty As String
Dim i As Integer
Dim j As Integer
Dim strWorksheet As String
Dim strWorksheetPath As String
Dim strTemplatePath As String
Dim appExcel As Excel.Application
Dim bks As Excel.Workbooks
Dim clk As Excel.Worksheet
Dim rng As Excel.Range
Dim sel As Object
Dim strRange As String
Dim lngASCII As Long
Dim strASCII As String


Set appExcel = GetObject(, "Excel.Application")
strTemplatePath = "C:\ywca\january 2009\"
strWorksheet = "CountyTemplate.xlt"
strWorksheetPath = strTemplatePath & strWorksheet
strEmpty = Chr$(34) & Chr$(34)


Set bks = appExcel.Workbooks


'Open the workbook
bks.Add strWorksheetPath


'set reference to a query/table
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblCountyTemplate")
lngCount = rst.RecordCount
If lngCount = 0 Then
MsgBox "No Records to Export"
Exit Sub
Else
MsgBox lngCount & " records to export to Excel"
End If


'Adjust the counter to be 1 less than the row number of the first
'body row of the worksheet
i = 1


'Initialize column letters with 64, so the first letter used will be
A
lngASCII = 64


'Loop through table, importing each record to a cell in the worksheet
Do Until rst.EOF
With rst
'Create variables from a record
If ![CH_CYFCase] < strEmpty Then
strCaseNumber = ![CH_CYFCase]
Debug.Print strCaseNumber
End If


If ![CH_SequenceNumber] < strEmpty Then
strSeqNum = ![CH_SequenceNumber]
Debug.Print strSeqNum
End If


If ![CH_LName] < strEmpty Then
strLname = ![CH_LName]
Debug.Print strLname
End If


If ![CH_FName] < strEmpty Then
strFname = ![CH_FName]
Debug.Print strFname
End If


If ![CH_DOB] < strEmpty Then
strDOB = ![CH_DOB]
Debug.Print strDOB
End If


End With


'Write Access data directly to cells in worksheet
i = i + 1
lngASCII = lngASCII + 2
strASCII = Chr(lngASCII)
strRange = strASCII & CStr(i)
Set sel = appExcel.Selection


Set rng = sel.Range(strRange)
If strCaseNumber < strEmpty Then
rng.Value = strCaseNumber
End If


lngASCII = lngASCII + 1
strASCII = Chr(lngASCII)
strRange = strASCII & CStr(i)
Set rng = sel.Range(strRange)
rng.Value = strSeqNum


lngASCII = lngASCII + 1
strASCII = Chr(lngASCII)
strRange = strASCII & CStr(i)
Set rng = sel.Range(strRange)
rng.Value = strLname


lngASCII = lngASCII + 1
strASCII = Chr(lngASCII)
strRange = strASCII & CStr(i)
Set rng = sel.Range(strRange)
rng.Value = strFname


lngASCII = lngASCII + 2
strASCII = Chr(lngASCII)
strRange = strASCII & CStr(i)
Set rng = sel.Range(strRange)
rng.Value = strDOB


lngASCII = 64
rst.MoveNext
Loop


MsgBox "All Items exported!"


'Make worksheet visible
appExcel.Application.Visible = True


ErrorHandlerExit:
Exit Sub


ErrorHandler:
If Err = 429 Then


'Excel is not running; open Excel with CreateObject
Set appExcel = CreateObject("Excel.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number & "; Description: " &
Err.Description
Resume ErrorHandlerExit
End If


I tried posting in an Access group but it was suggested that I try an
Excel group. Thank you.