I don't know if anyone will be able to help me or not. I have recently taken over the programming and management of a database for a local charity.
I am trying to create a new vba code to create a excel spreadsheet base on 2 queries. I have used a vba code from another coding in the same database (that the last person created) and changed the names of the excel workbook and worksheets.
But I am getting Error numer438Object doesn't support this property or method.
I hope this makes sense.
Private Sub cmdDonatedSpreadsheet_Click()
Dim appXL As Excel.Application
Dim wbDonated As Excel.Workbook
Dim wsDonated As Excel.Worksheet
Dim strDesktop As String
Dim DB As DAO.Database
Dim rec As DAO.Recordset
Dim f As DAO.Field
Dim i As Integer
Dim j As Integer
Dim k As Integer
On Error GoTo errHandler
'DoCmd .Hourglass True
'DoCmd .Minimize
Set appXL = New Excel.Application
Set DB = CurrentDb()
appXL.Visible = True
Set wbDonated = appXL.Workbooks.Add
wbDonated.Activate
For k = 1 To 2
'loop round two sheets
If k > 1 Then
wbDonated.Sheets.Add
End If
Set wsDonated = wbDonated.DonatedSheet
Select Case k
Case 1
wsDonated.Name = "DonatedActiveFriend"
Set rec = DB.OpenRecordset("qryActiveDonated")
wsDonated.Range("A2").Select
appXL.ActiveWindow.FreezePanes = True
Case 2
wsDonated.Name = "NotDonatedActiveFriend"
Set rec = DB.OpenRecordset("qryActiveNotDonated")
wsDonated.Range("A2").Select
appXL.ActiveWindow.FreezePanes = True
End Select
With rec
.MoveFirst
i = 1 'row
j = 1 'column
For Each f In .Fields
wsDonated.Cells(i, j).Value = f.Name
j = j + 1
Next f
Do
i = i + 1
j = 1
For Each f In .Fields
wsDonated.Cells(i, j).Value = f.Value
j = j + 1
Next f
.MoveNext
Loop Until .EOF
End With
rec.Close
Next k
DB.Close
'strDesktop = "C:\Users\FOTYH\Desktop\Donated.xlsx
strDesktop = "C:\Users\User\Desktop\Donated.xlsx"
Startfile:
wbDonated.SaveAs strDesktop
'DoCmd.Hourglass False
MsgBox "Donated/NotDonated Spreadsheets Created On Desktop!"
wbDonated.Close
appXL.Quit
'DoCmd.Maximize
Exit Sub
errHandler:
'If Err = 76 Then
If Err = 1004 Then
strDesktop = "C:\Users\FOTYH\Desktop\Donated.xlsx"
Resume Startfile
Else
MsgBox "Error number " & Err & Err.Description
Exit Sub
End If
End Sub
