Coding error with excel export

W

Wuelf

Greetings,
Firstly I should point out that I have very limited access experience, as
such I try my best with help files, tutorials and forums.

I have put together a excel export from access which seems to work ok when I
have a date criteria in the query with a defined date Between #20/07/09# and
#26/07/09# but when I have the following criteria Between [forms]![criteria -
payroll report]![txtdate] And [forms]![criteria - payroll report]![txtDate]-6
I keep getting the Too few parameters error. Could someone please advise
where I've gone astray ... thanks in advance Jack

Private Sub butExcel_Click()

Dim db As Database
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objPivotTable As Excel.PivotTable
Dim lngRows As Long
Dim iWeekday As Integer

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryTimesheet - Excel Payroll Dump")
Set objBook = Workbooks.Add(Template:="c:\chloe\documents\Payroll Excel.xls")
Set objApp = objBook.Parent
objBook.Windows(1).Visible = True
Set objPivotTable = objBook.Worksheets("Timesheet").Range("A3").PivotTable
Set rst = qdf.OpenRecordset(dbOpenDynaset)

lngRows = rst.RecordCount
iWeekday = WeekDay(txtDate)

If IsNull(txtDate) Then
MsgBox "You must enter the week ending date!", vbOKOnly, "CHLOE"
txtDate.SetFocus
Exit Sub
End If

If iWeekday = vbSunday Then
Me.Visible = False
Else
txtDate.SetFocus
txtDate = Empty
Exit Sub
End If

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm

With objBook.Worksheets("Raw")
..Range("a2").CopyFromRecordset rst
..Visible = xlSheetHidden
End With

objPivotTable.RefreshTable

With objBook.Worksheets("Timesheet")
..Range("E2:M2").Font.Bold = True
..Range("E2:M2").HorizontalAlignment = xlCenter
..Range("E:M").ColumnWidth = 10
End With

objApp.Visible = True

objBook.SaveAs Filename:="c:\Chloe\Payroll\WE " & Format(txtDate,
("dd-MMM-yy ")) & txtInitial & ".xls"

objApp.Quit

Set db = Nothing
Set rst = Nothing
Set qdf = Nothing
Set prm = Nothing
Set objApp = Nothing
Set objBook = Nothing

rst.Close

DoCmd.Close acForm, "Criteria - Payroll Report", acSaveNo

Errortrap:
'MsgBox "Error!!", vbOKOnly, "CHLOE"On Error GoTo Errortrap

End Sub
 
K

Ken Snell [MVP]

You need to evaluate the parameters *before* you open the recordset:

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
 
W

Wuelf

Thanks for the response Ken

I moved the Set rst = qdf.OpenRecordset(dbOpenDynaset) under For each prm
.... as suggested then I received error 91 Object Variable or With block
variable not set on the lngRows = rst.RecordCount line so I moved that under
the Set rst = ... line and now I get error 3464 Data type mismatch in
criteria expression and once again I'm stumped ... sorry but can you help?
.... cheers

Ken Snell said:
You need to evaluate the parameters *before* you open the recordset:

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/



Wuelf said:
Greetings,
Firstly I should point out that I have very limited access experience, as
such I try my best with help files, tutorials and forums.

I have put together a excel export from access which seems to work ok when
I
have a date criteria in the query with a defined date Between #20/07/09#
and
#26/07/09# but when I have the following criteria Between
[forms]![criteria -
payroll report]![txtdate] And [forms]![criteria - payroll
report]![txtDate]-6
I keep getting the Too few parameters error. Could someone please advise
where I've gone astray ... thanks in advance Jack

Private Sub butExcel_Click()

Dim db As Database
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objPivotTable As Excel.PivotTable
Dim lngRows As Long
Dim iWeekday As Integer

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryTimesheet - Excel Payroll Dump")
Set objBook = Workbooks.Add(Template:="c:\chloe\documents\Payroll
Excel.xls")
Set objApp = objBook.Parent
objBook.Windows(1).Visible = True
Set objPivotTable = objBook.Worksheets("Timesheet").Range("A3").PivotTable
Set rst = qdf.OpenRecordset(dbOpenDynaset)

lngRows = rst.RecordCount
iWeekday = WeekDay(txtDate)

If IsNull(txtDate) Then
MsgBox "You must enter the week ending date!", vbOKOnly, "CHLOE"
txtDate.SetFocus
Exit Sub
End If

If iWeekday = vbSunday Then
Me.Visible = False
Else
txtDate.SetFocus
txtDate = Empty
Exit Sub
End If

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm

With objBook.Worksheets("Raw")
.Range("a2").CopyFromRecordset rst
.Visible = xlSheetHidden
End With

objPivotTable.RefreshTable

With objBook.Worksheets("Timesheet")
.Range("E2:M2").Font.Bold = True
.Range("E2:M2").HorizontalAlignment = xlCenter
.Range("E:M").ColumnWidth = 10
End With

objApp.Visible = True

objBook.SaveAs Filename:="c:\Chloe\Payroll\WE " & Format(txtDate,
("dd-MMM-yy ")) & txtInitial & ".xls"

objApp.Quit

Set db = Nothing
Set rst = Nothing
Set qdf = Nothing
Set prm = Nothing
Set objApp = Nothing
Set objBook = Nothing

rst.Close

DoCmd.Close acForm, "Criteria - Payroll Report", acSaveNo

Errortrap:
'MsgBox "Error!!", vbOKOnly, "CHLOE"On Error GoTo Errortrap

End Sub
Click to expand...
Click to expand...
 
K

Ken Snell [MVP]

Move the qdf.Parameters loop higher in the code:

Private Sub butExcel_Click()

Dim db As Database
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objPivotTable As Excel.PivotTable
Dim lngRows As Long
Dim iWeekday As Integer

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryTimesheet - Excel Payroll Dump")

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm

Set objBook = Workbooks.Add(Template:="c:\chloe\documents\Payroll
Excel.xls")
Set objApp = objBook.Parent
objBook.Windows(1).Visible = True
Set objPivotTable = objBook.Worksheets("Timesheet").Range("A3").PivotTable

Set rst = qdf.OpenRecordset(dbOpenDynaset)

lngRows = rst.RecordCount
iWeekday = WeekDay(txtDate)

If IsNull(txtDate) Then
MsgBox "You must enter the week ending date!", vbOKOnly, "CHLOE"
txtDate.SetFocus
Exit Sub
End If

If iWeekday = vbSunday Then
Me.Visible = False
Else
txtDate.SetFocus
txtDate = Empty
Exit Sub
End If

With objBook.Worksheets("Raw")
..Range("a2").CopyFromRecordset rst
..Visible = xlSheetHidden
End With

objPivotTable.RefreshTable

With objBook.Worksheets("Timesheet")
..Range("E2:M2").Font.Bold = True
..Range("E2:M2").HorizontalAlignment = xlCenter
..Range("E:M").ColumnWidth = 10
End With

objApp.Visible = True

objBook.SaveAs Filename:="c:\Chloe\Payroll\WE " & Format(txtDate,
("dd-MMM-yy ")) & txtInitial & ".xls"

objApp.Quit

Set db = Nothing
Set rst = Nothing
Set qdf = Nothing
Set prm = Nothing
Set objApp = Nothing
Set objBook = Nothing

rst.Close

DoCmd.Close acForm, "Criteria - Payroll Report", acSaveNo

Errortrap:
'MsgBox "Error!!", vbOKOnly, "CHLOE"On Error GoTo Errortrap

End Sub

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/



Wuelf said:
Thanks for the response Ken

I moved the Set rst = qdf.OpenRecordset(dbOpenDynaset) under For each prm
... as suggested then I received error 91 Object Variable or With block
variable not set on the lngRows = rst.RecordCount line so I moved that
under
the Set rst = ... line and now I get error 3464 Data type mismatch in
criteria expression and once again I'm stumped ... sorry but can you help?
... cheers

Ken Snell said:
You need to evaluate the parameters *before* you open the recordset:

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/



Wuelf said:
Greetings,
Firstly I should point out that I have very limited access experience,
as
such I try my best with help files, tutorials and forums.

I have put together a excel export from access which seems to work ok
when
I
have a date criteria in the query with a defined date Between
#20/07/09#
and
#26/07/09# but when I have the following criteria Between
[forms]![criteria -
payroll report]![txtdate] And [forms]![criteria - payroll
report]![txtDate]-6
I keep getting the Too few parameters error. Could someone please
advise
where I've gone astray ... thanks in advance Jack

Private Sub butExcel_Click()

Dim db As Database
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objPivotTable As Excel.PivotTable
Dim lngRows As Long
Dim iWeekday As Integer

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryTimesheet - Excel Payroll Dump")
Set objBook = Workbooks.Add(Template:="c:\chloe\documents\Payroll
Excel.xls")
Set objApp = objBook.Parent
objBook.Windows(1).Visible = True
Set objPivotTable =
objBook.Worksheets("Timesheet").Range("A3").PivotTable
Set rst = qdf.OpenRecordset(dbOpenDynaset)

lngRows = rst.RecordCount
iWeekday = WeekDay(txtDate)

If IsNull(txtDate) Then
MsgBox "You must enter the week ending date!", vbOKOnly, "CHLOE"
txtDate.SetFocus
Exit Sub
End If

If iWeekday = vbSunday Then
Me.Visible = False
Else
txtDate.SetFocus
txtDate = Empty
Exit Sub
End If

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm

With objBook.Worksheets("Raw")
.Range("a2").CopyFromRecordset rst
.Visible = xlSheetHidden
End With

objPivotTable.RefreshTable

With objBook.Worksheets("Timesheet")
.Range("E2:M2").Font.Bold = True
.Range("E2:M2").HorizontalAlignment = xlCenter
.Range("E:M").ColumnWidth = 10
End With

objApp.Visible = True

objBook.SaveAs Filename:="c:\Chloe\Payroll\WE " & Format(txtDate,
("dd-MMM-yy ")) & txtInitial & ".xls"

objApp.Quit

Set db = Nothing
Set rst = Nothing
Set qdf = Nothing
Set prm = Nothing
Set objApp = Nothing
Set objBook = Nothing

rst.Close

DoCmd.Close acForm, "Criteria - Payroll Report", acSaveNo

Errortrap:
'MsgBox "Error!!", vbOKOnly, "CHLOE"On Error GoTo Errortrap

End Sub
Click to expand...
Click to expand...
Click to expand...
 
W

Wuelf

Sorry Ken, I cut and pasted your changes but I still get "Error 3464 Data
type mismatch inccriteria expression" any other ideas? thanks

Ken Snell said:
Move the qdf.Parameters loop higher in the code:

Private Sub butExcel_Click()

Dim db As Database
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objPivotTable As Excel.PivotTable
Dim lngRows As Long
Dim iWeekday As Integer

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryTimesheet - Excel Payroll Dump")

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm

Set objBook = Workbooks.Add(Template:="c:\chloe\documents\Payroll
Excel.xls")
Set objApp = objBook.Parent
objBook.Windows(1).Visible = True
Set objPivotTable = objBook.Worksheets("Timesheet").Range("A3").PivotTable

Set rst = qdf.OpenRecordset(dbOpenDynaset)

lngRows = rst.RecordCount
iWeekday = WeekDay(txtDate)

If IsNull(txtDate) Then
MsgBox "You must enter the week ending date!", vbOKOnly, "CHLOE"
txtDate.SetFocus
Exit Sub
End If

If iWeekday = vbSunday Then
Me.Visible = False
Else
txtDate.SetFocus
txtDate = Empty
Exit Sub
End If

With objBook.Worksheets("Raw")
..Range("a2").CopyFromRecordset rst
..Visible = xlSheetHidden
End With

objPivotTable.RefreshTable

With objBook.Worksheets("Timesheet")
..Range("E2:M2").Font.Bold = True
..Range("E2:M2").HorizontalAlignment = xlCenter
..Range("E:M").ColumnWidth = 10
End With

objApp.Visible = True

objBook.SaveAs Filename:="c:\Chloe\Payroll\WE " & Format(txtDate,
("dd-MMM-yy ")) & txtInitial & ".xls"

objApp.Quit

Set db = Nothing
Set rst = Nothing
Set qdf = Nothing
Set prm = Nothing
Set objApp = Nothing
Set objBook = Nothing

rst.Close

DoCmd.Close acForm, "Criteria - Payroll Report", acSaveNo

Errortrap:
'MsgBox "Error!!", vbOKOnly, "CHLOE"On Error GoTo Errortrap

End Sub

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/



Wuelf said:
Thanks for the response Ken

I moved the Set rst = qdf.OpenRecordset(dbOpenDynaset) under For each prm
... as suggested then I received error 91 Object Variable or With block
variable not set on the lngRows = rst.RecordCount line so I moved that
under
the Set rst = ... line and now I get error 3464 Data type mismatch in
criteria expression and once again I'm stumped ... sorry but can you help?
... cheers

Ken Snell said:
You need to evaluate the parameters *before* you open the recordset:

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/



Greetings,
Firstly I should point out that I have very limited access experience,
as
such I try my best with help files, tutorials and forums.

I have put together a excel export from access which seems to work ok
when
I
have a date criteria in the query with a defined date Between
#20/07/09#
and
#26/07/09# but when I have the following criteria Between
[forms]![criteria -
payroll report]![txtdate] And [forms]![criteria - payroll
report]![txtDate]-6
I keep getting the Too few parameters error. Could someone please
advise
where I've gone astray ... thanks in advance Jack

Private Sub butExcel_Click()

Dim db As Database
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objPivotTable As Excel.PivotTable
Dim lngRows As Long
Dim iWeekday As Integer

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryTimesheet - Excel Payroll Dump")
Set objBook = Workbooks.Add(Template:="c:\chloe\documents\Payroll
Excel.xls")
Set objApp = objBook.Parent
objBook.Windows(1).Visible = True
Set objPivotTable =
objBook.Worksheets("Timesheet").Range("A3").PivotTable
Set rst = qdf.OpenRecordset(dbOpenDynaset)

lngRows = rst.RecordCount
iWeekday = WeekDay(txtDate)

If IsNull(txtDate) Then
MsgBox "You must enter the week ending date!", vbOKOnly, "CHLOE"
txtDate.SetFocus
Exit Sub
End If

If iWeekday = vbSunday Then
Me.Visible = False
Else
txtDate.SetFocus
txtDate = Empty
Exit Sub
End If

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm

With objBook.Worksheets("Raw")
.Range("a2").CopyFromRecordset rst
.Visible = xlSheetHidden
End With

objPivotTable.RefreshTable

With objBook.Worksheets("Timesheet")
.Range("E2:M2").Font.Bold = True
.Range("E2:M2").HorizontalAlignment = xlCenter
.Range("E:M").ColumnWidth = 10
End With

objApp.Visible = True

objBook.SaveAs Filename:="c:\Chloe\Payroll\WE " & Format(txtDate,
("dd-MMM-yy ")) & txtInitial & ".xls"

objApp.Quit

Set db = Nothing
Set rst = Nothing
Set qdf = Nothing
Set prm = Nothing
Set objApp = Nothing
Set objBook = Nothing

rst.Close

DoCmd.Close acForm, "Criteria - Payroll Report", acSaveNo

Errortrap:
'MsgBox "Error!!", vbOKOnly, "CHLOE"On Error GoTo Errortrap

End Sub
Click to expand...
Click to expand...
Click to expand...
 
K

Ken Snell [MVP]

On which code step line do you get that error?

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/


Wuelf said:
Sorry Ken, I cut and pasted your changes but I still get "Error 3464 Data
type mismatch inccriteria expression" any other ideas? thanks

Ken Snell said:
Move the qdf.Parameters loop higher in the code:

Private Sub butExcel_Click()

Dim db As Database
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objPivotTable As Excel.PivotTable
Dim lngRows As Long
Dim iWeekday As Integer

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryTimesheet - Excel Payroll Dump")

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm

Set objBook = Workbooks.Add(Template:="c:\chloe\documents\Payroll
Excel.xls")
Set objApp = objBook.Parent
objBook.Windows(1).Visible = True
Set objPivotTable =
objBook.Worksheets("Timesheet").Range("A3").PivotTable

Set rst = qdf.OpenRecordset(dbOpenDynaset)

lngRows = rst.RecordCount
iWeekday = WeekDay(txtDate)

If IsNull(txtDate) Then
MsgBox "You must enter the week ending date!", vbOKOnly, "CHLOE"
txtDate.SetFocus
Exit Sub
End If

If iWeekday = vbSunday Then
Me.Visible = False
Else
txtDate.SetFocus
txtDate = Empty
Exit Sub
End If

With objBook.Worksheets("Raw")
..Range("a2").CopyFromRecordset rst
..Visible = xlSheetHidden
End With

objPivotTable.RefreshTable

With objBook.Worksheets("Timesheet")
..Range("E2:M2").Font.Bold = True
..Range("E2:M2").HorizontalAlignment = xlCenter
..Range("E:M").ColumnWidth = 10
End With

objApp.Visible = True

objBook.SaveAs Filename:="c:\Chloe\Payroll\WE " & Format(txtDate,
("dd-MMM-yy ")) & txtInitial & ".xls"

objApp.Quit

Set db = Nothing
Set rst = Nothing
Set qdf = Nothing
Set prm = Nothing
Set objApp = Nothing
Set objBook = Nothing

rst.Close

DoCmd.Close acForm, "Criteria - Payroll Report", acSaveNo

Errortrap:
'MsgBox "Error!!", vbOKOnly, "CHLOE"On Error GoTo Errortrap

End Sub

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/



Wuelf said:
Thanks for the response Ken

I moved the Set rst = qdf.OpenRecordset(dbOpenDynaset) under For each
prm
... as suggested then I received error 91 Object Variable or With block
variable not set on the lngRows = rst.RecordCount line so I moved that
under
the Set rst = ... line and now I get error 3464 Data type mismatch in
criteria expression and once again I'm stumped ... sorry but can you
help?
... cheers

:

You need to evaluate the parameters *before* you open the recordset:

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/



Greetings,
Firstly I should point out that I have very limited access
experience,
as
such I try my best with help files, tutorials and forums.

I have put together a excel export from access which seems to work
ok
when
I
have a date criteria in the query with a defined date Between
#20/07/09#
and
#26/07/09# but when I have the following criteria Between
[forms]![criteria -
payroll report]![txtdate] And [forms]![criteria - payroll
report]![txtDate]-6
I keep getting the Too few parameters error. Could someone please
advise
where I've gone astray ... thanks in advance Jack

Private Sub butExcel_Click()

Dim db As Database
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objPivotTable As Excel.PivotTable
Dim lngRows As Long
Dim iWeekday As Integer

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryTimesheet - Excel Payroll Dump")
Set objBook = Workbooks.Add(Template:="c:\chloe\documents\Payroll
Excel.xls")
Set objApp = objBook.Parent
objBook.Windows(1).Visible = True
Set objPivotTable =
objBook.Worksheets("Timesheet").Range("A3").PivotTable
Set rst = qdf.OpenRecordset(dbOpenDynaset)

lngRows = rst.RecordCount
iWeekday = WeekDay(txtDate)

If IsNull(txtDate) Then
MsgBox "You must enter the week ending date!", vbOKOnly, "CHLOE"
txtDate.SetFocus
Exit Sub
End If

If iWeekday = vbSunday Then
Me.Visible = False
Else
txtDate.SetFocus
txtDate = Empty
Exit Sub
End If

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm

With objBook.Worksheets("Raw")
.Range("a2").CopyFromRecordset rst
.Visible = xlSheetHidden
End With

objPivotTable.RefreshTable

With objBook.Worksheets("Timesheet")
.Range("E2:M2").Font.Bold = True
.Range("E2:M2").HorizontalAlignment = xlCenter
.Range("E:M").ColumnWidth = 10
End With

objApp.Visible = True

objBook.SaveAs Filename:="c:\Chloe\Payroll\WE " & Format(txtDate,
("dd-MMM-yy ")) & txtInitial & ".xls"

objApp.Quit

Set db = Nothing
Set rst = Nothing
Set qdf = Nothing
Set prm = Nothing
Set objApp = Nothing
Set objBook = Nothing

rst.Close

DoCmd.Close acForm, "Criteria - Payroll Report", acSaveNo

Errortrap:
'MsgBox "Error!!", vbOKOnly, "CHLOE"On Error GoTo Errortrap

End Sub
Click to expand...
Click to expand...
Click to expand...
 
K

Ken Snell [MVP]

Change this line:
Dim rst As Recordset

to this:
Dim rst As DAO.Recordset

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/


Wuelf said:
Sorry Ken, I cut and pasted your changes but I still get "Error 3464 Data
type mismatch inccriteria expression" any other ideas? thanks

Ken Snell said:
Move the qdf.Parameters loop higher in the code:

Private Sub butExcel_Click()

Dim db As Database
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objPivotTable As Excel.PivotTable
Dim lngRows As Long
Dim iWeekday As Integer

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryTimesheet - Excel Payroll Dump")

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm

Set objBook = Workbooks.Add(Template:="c:\chloe\documents\Payroll
Excel.xls")
Set objApp = objBook.Parent
objBook.Windows(1).Visible = True
Set objPivotTable =
objBook.Worksheets("Timesheet").Range("A3").PivotTable

Set rst = qdf.OpenRecordset(dbOpenDynaset)

lngRows = rst.RecordCount
iWeekday = WeekDay(txtDate)

If IsNull(txtDate) Then
MsgBox "You must enter the week ending date!", vbOKOnly, "CHLOE"
txtDate.SetFocus
Exit Sub
End If

If iWeekday = vbSunday Then
Me.Visible = False
Else
txtDate.SetFocus
txtDate = Empty
Exit Sub
End If

With objBook.Worksheets("Raw")
..Range("a2").CopyFromRecordset rst
..Visible = xlSheetHidden
End With

objPivotTable.RefreshTable

With objBook.Worksheets("Timesheet")
..Range("E2:M2").Font.Bold = True
..Range("E2:M2").HorizontalAlignment = xlCenter
..Range("E:M").ColumnWidth = 10
End With

objApp.Visible = True

objBook.SaveAs Filename:="c:\Chloe\Payroll\WE " & Format(txtDate,
("dd-MMM-yy ")) & txtInitial & ".xls"

objApp.Quit

Set db = Nothing
Set rst = Nothing
Set qdf = Nothing
Set prm = Nothing
Set objApp = Nothing
Set objBook = Nothing

rst.Close

DoCmd.Close acForm, "Criteria - Payroll Report", acSaveNo

Errortrap:
'MsgBox "Error!!", vbOKOnly, "CHLOE"On Error GoTo Errortrap

End Sub

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/



Wuelf said:
Thanks for the response Ken

I moved the Set rst = qdf.OpenRecordset(dbOpenDynaset) under For each
prm
... as suggested then I received error 91 Object Variable or With block
variable not set on the lngRows = rst.RecordCount line so I moved that
under
the Set rst = ... line and now I get error 3464 Data type mismatch in
criteria expression and once again I'm stumped ... sorry but can you
help?
... cheers

:

You need to evaluate the parameters *before* you open the recordset:

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/



Greetings,
Firstly I should point out that I have very limited access
experience,
as
such I try my best with help files, tutorials and forums.

I have put together a excel export from access which seems to work
ok
when
I
have a date criteria in the query with a defined date Between
#20/07/09#
and
#26/07/09# but when I have the following criteria Between
[forms]![criteria -
payroll report]![txtdate] And [forms]![criteria - payroll
report]![txtDate]-6
I keep getting the Too few parameters error. Could someone please
advise
where I've gone astray ... thanks in advance Jack

Private Sub butExcel_Click()

Dim db As Database
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objPivotTable As Excel.PivotTable
Dim lngRows As Long
Dim iWeekday As Integer

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryTimesheet - Excel Payroll Dump")
Set objBook = Workbooks.Add(Template:="c:\chloe\documents\Payroll
Excel.xls")
Set objApp = objBook.Parent
objBook.Windows(1).Visible = True
Set objPivotTable =
objBook.Worksheets("Timesheet").Range("A3").PivotTable
Set rst = qdf.OpenRecordset(dbOpenDynaset)

lngRows = rst.RecordCount
iWeekday = WeekDay(txtDate)

If IsNull(txtDate) Then
MsgBox "You must enter the week ending date!", vbOKOnly, "CHLOE"
txtDate.SetFocus
Exit Sub
End If

If iWeekday = vbSunday Then
Me.Visible = False
Else
txtDate.SetFocus
txtDate = Empty
Exit Sub
End If

For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm

With objBook.Worksheets("Raw")
.Range("a2").CopyFromRecordset rst
.Visible = xlSheetHidden
End With

objPivotTable.RefreshTable

With objBook.Worksheets("Timesheet")
.Range("E2:M2").Font.Bold = True
.Range("E2:M2").HorizontalAlignment = xlCenter
.Range("E:M").ColumnWidth = 10
End With

objApp.Visible = True

objBook.SaveAs Filename:="c:\Chloe\Payroll\WE " & Format(txtDate,
("dd-MMM-yy ")) & txtInitial & ".xls"

objApp.Quit

Set db = Nothing
Set rst = Nothing
Set qdf = Nothing
Set prm = Nothing
Set objApp = Nothing
Set objBook = Nothing

rst.Close

DoCmd.Close acForm, "Criteria - Payroll Report", acSaveNo

Errortrap:
'MsgBox "Error!!", vbOKOnly, "CHLOE"On Error GoTo Errortrap

End Sub
Click to expand...
Click to expand...
Click to expand...
 

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

Similar Threads

Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0
Multi-Select List Box 3
Access-Excel-Email- 0
Error 3061 - produced by 2 out of 3 same reports 5
Listbox execute SQL error 2
VBA works in orignal but fails in copy of database 1
Re-using a recordset 6
New record on a new day (re-post) 12

Top