Export to Excel

G

Guest

Could someone look at the following code and tell me why the code stops at

.Range("ExternalData").Clear 'Clears the current data in the workbook range



Option Compare Database
Option Explicit

Private Sub cmdClose_Click()
DoCmd.Close
End Sub

Private Sub Form_Load()
Dim strPath As String
Dim strIconFile As String

strPath = CurrentDb.Name
strIconFile = "Green Bug.Ico" ' Place Icon File Name Here

Do While Right(strPath, 1) <> "\"
strPath = Left(strPath, Len(strPath) - 1)
Loop
strPath = strPath & strIconFile
SetFormIcon Me.hwnd, strPath
StartDate.SetFocus
End Sub

Private Sub cmdTransferDataToExcel_Click()
On Error Resume Next
Dim sCriteria As String
Dim db As Database
Dim rst As Recordset
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim Path As String

sCriteria = " 1 = 1 "

If Index <> "" Then
sCriteria = sCriteria & " AND qryTransferDataToExcel.Index =
""" & Index & """"
End If

If Title <> "" Then
sCriteria = sCriteria & " AND qryTransferDataToExcel.Title like
""" & Title & "*"""
End If

If AreaCode <> "" Then
sCriteria = sCriteria & " AND
qryTransferDataToExcel.AreaCode = """ & AreaCode & """"
End If

If NewsPaper <> "" Then
sCriteria = sCriteria & " AND
qryTransferDataToExcel.NewsPaper = """ & NewsPaper & """"
End If

If StartDate <> "" And EndDate <> "" Then
sCriteria = sCriteria & " AND qryTransferDataToExcel.DateOfPaper
between #" & Format(StartDate, "dd-mmm-yyyy") & "# and #" & Format(EndDate,
"dd-mmm-yyyy") & "#"
End If

If Subject <> "" Then
sCriteria = sCriteria & " AND qryTransferDataToExcel.Subject
like """ & Subject & "*"""
End If


Set db = CurrentDb()

Set objBook = Workbooks.Add(Template:=CurrentProject.Path &
"\TransferDataToExcel.xlt") 'Your excel spreadsheet file goes here
Set objApp = objBook.Parent
Set objSheet = objBook.Worksheets("News") 'Name of sheet
you want to export to
objBook.Windows(1).Visible = True
Set rst = db.OpenRecordset("SELECT * FROM
qryTransferDataToExcel WHERE " & sCriteria, dbOpenSnapshot) 'dbOpenDynaset
dbOpenSnapshot) 'Opens the recordset and sets the variable
With objSheet
.Select
.Range("ExternalData").Clear 'Clears the current data in
the workbook range
.Range("A9").CopyFromRecordset rst 'rst Copies the recordset
into the worksheet
End With
rst.Close
objApp.Visible = True
Set rst = Nothing
Set db = Nothing
Set objSheet = Nothing
Set objBook = Nothing
Set objApp = Nothing

End Sub

Any help would greatly be appreciated!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top