Can anyone explain why this code generates an error 438 every other time on the past line?
	
	
	
		
 'Use this function to export a large table/query from your database to a new Excel workbook.
'You can also specify the name of the worksheet target.
'strSourceName is the name of the table/query you want to export to Excel.
'strWorkbookPath is the path of the workbook you want to export the data.
'strTargetSheetName is the desired name of the target sheet.
'By Christos Samaras
'http://www.myengineeringworld.net
	
	
	
		
 'Set the desired recordset (table/query).
	
	
	
		
 'Create a new Excel instance.
	
	
	
		
'Try to open the specified workbook. 
	
	
	
		
'Write the headings in the target sheet.
	
	
	
		
'Copy the data in the target sheet.
rst.MoveFirst
	
	
	
		
 The code crashes on the .copy line every other time.
I can see it selected the correct parts in the sheet both times.
'Close the recordset.
	
	
	
		
 
		Code:
	
	
	Function DataToExcel(strSourceName As String, Optional strWorkbookPath As String, Optional strTargetFileName As String, Optional strCallingForm As String)
	'You can also specify the name of the worksheet target.
'strSourceName is the name of the table/query you want to export to Excel.
'strWorkbookPath is the path of the workbook you want to export the data.
'strTargetSheetName is the desired name of the target sheet.
'By Christos Samaras
'http://www.myengineeringworld.net
		Code:
	
	
	 Dim rst As DAO.Recordset
Dim excelApp As Object
Dim Wbk As Object
Dim sht As Object
Dim fldHeadings As DAO.Field
Dim strTargetSheetName As String
 strTargetSheetName = "AccessData"
	
		Code:
	
	
	Set rst = CurrentDb.OpenRecordset(strSourceName)
	
		Code:
	
	
	Set excelApp = CreateObject("Excel.Application")
On Error GoTo Errorhandler
	
		Code:
	
	
	Set Wbk = excelApp.Workbooks.Open(strWorkbookPath)
excelApp.Visible = True
Set sht = excelApp.ActiveWorkbook.Sheets(2)
sht.Activate
excelApp.ActiveWorkbook.SaveAs strTargetFileName
	
		Code:
	
	
	For Each fldHeadings In rst.Fields
     excelApp.ActiveCell = fldHeadings.Name
     excelApp.ActiveCell.Offset(0, 1).Select
Next
	rst.MoveFirst
		Code:
	
	
	sht.Range("A2").CopyFromRecordset rst
sht.Range("1:1").Select
sht.Rows("2:2").Select
excelApp.ActiveWindow.FreezePanes = True
Set sht = excelApp.ActiveWorkbook.Sheets(1)
sht.Activate
Select Case strCallingForm
     Case "frmOrderAdd"
          sht.Range("B1:B26").Select
          With Selection
                [COLOR=red][B].Copy[/B][/COLOR]
              [COLOR=black]  .PasteSpecial Paste:=xlPasteValues[/COLOR]
          End With
     Case Else
          sht.Cells.Select
          With Selection
              [COLOR=red][B] .Copy[/B][/COLOR]
              [COLOR=red][/COLOR][COLOR=black].PasteSpecial Paste:=xlPasteValues[/COLOR]
          End With
 End Select
	I can see it selected the correct parts in the sheet both times.
'Close the recordset.
		Code:
	
	
	rst.Close
Set rst = Nothing
excelApp.ActiveWorkbook.Sheets("AccessData").Delete
excelApp.ActiveWorkbook.Save
excelApp.Quit
Exit Function
Errorhandler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Numb
Exit Function
End Function
	
			
				Last edited: