CODEWITHSUNDEEP
excelvbaoutlook
bilig james
bilig james

Reputation: 21

(1004) application defined or object defined error

I have received

(1004) application defined or object defined error

while trying to export Email sender and subject from Outlook to Excel. 

Sub GetFolderStats()
10 On Error GoTo Err

11    Dim objOutlook As Object
12    Dim objnSpace As Object
13    Dim objRootFolder As Object
14    Dim objInbox As Object
15    Dim mailSel As Outlook.Selection
16    Dim senderVal As String, titleVal As String

17    Dim path As String
18    Dim objExcel As Object
19    Dim objWorkbook As Object
20    Dim objSheet As Object

22    path = "example.xlsx"
23    Set objExcel = CreateObject("Excel.Application")
24    Set objWorkbook = objExcel.Workbooks.Open(path)
25    Set objSheet = objWorkbook.Sheets("Sheet1")

26    Set objOutlook = CreateObject("Outlook.Application")
27    Set objnSpace = objOutlook.GetNamespace("MAPI")
28    Set objRootFolder = objnSpace.Folders("RootFolder")
29    Set objInbox = objRootFolder.Folders("Inbox")

30    For Each Folder In objInbox.Folders
31        For Each i In Folder.Items
32            If (i.UnRead) Then
33                senderVal = i.SenderEmailAddress
34                titleVal = i.Subject
35                MsgBox senderVal + " " + titleVal
37                    NextEmptyRow = objSheet.Range("A" & objExcel.Rows.Count).End(xlUp).Row + 1
38                    objSheet.Range("A" & NextEmptyRow) = senderVal
39                    objSheet.Range("B" & NextEmptyRow) = titleVal
51              objWorkbook.Save
41          End If
42        Next
43    Next

Err:
140  MsgBox "Value: " & dblRnd & vbCrLf & _
            "Error Line: " & Erl & vbCrLf & _
            "Error: (" & Err.Number & ") " & Err.Description, vbCritical
            objWorkbook.Close
    Stop

End Sub

Line 37 gives me the error. I have tried sheet.activate, sheet.select neither worked. Also I tried several solutions I found online, none of them worked.

Upvotes: 0

Views: 120

Answers (1)

Alina Li
Alina Li

Reputation: 884

Could you please refer to this solution below:

Const xlExcel7 = 39

Set objFso = CreateObject("Scripting.FileSystemObject") 
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = true

strPathExcel = "C:\Scripts\"
strFile = "DesktopLocation"
strYear = Right(Year(Date),2)
strDay = Day(Date)
strMonth = Month(Date)

strSaveFile = strPathExcel & strFile & "-" & strYear & _
  "-" & strMonth & "-" & strDay & ".xls"

If objFso.FileExists(strSaveFile) Then
  Set objWorkbook = objExcel.Workbooks.Open(strSaveFile)
Else
  Set objWorkbook = objExcel.Workbooks.Add
  objWorkbook.Sheets(1).Name = "Default"
  objWorkbook.Sheets(2).Name = "Locked Down"
  objWorkbook.Sheets(3).Name = "Other"
  objWorkbook.SaveAs strSaveFile, xlExcel7
End If

arrSample = Array("a, b, c, d")

OutputExcel "Default", arrSample, objWorkbook.Sheets("Default")
OutputExcel "Locked Down", arrSample, objWorkbook.Sheets("Locked Down")
OutputExcel "Other", arrSample, objWorkbook.Sheets("Other")

objWorkbook.Save
objWorkbook.Close
objExcel.Quit



Sub OutputExcel(ByVal location, ByVal strArray, ByRef objSheet)

  ' Add data to the sheet
  objSheet.Cells(1, 1) = location & now
  ' Save the workbook
  objSheet.Parent.Save

End Sub

For more information, please see

Adding additional lines into an excel spreadsheet with VBscript

Upvotes: 1

Related Questions