Access export to Excel template with merged cells

  • Thread starter Thread starter clk
  • Start date Start date
C

clk

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 think you are right that the merged cells are the problem. I think you
should ask this in and excel group for more info on how to do the import and
avoid the problem.
clk said:
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
Click to expand...
 
Back
Top