(1004) определена ошибка приложения или объекта - PullRequest
Новая
       12

(1004) определена ошибка приложения или объекта

0 голосов
/ 13 сентября 2018

Я получил

(1004) ошибка приложения или объекта *

при попытке экспортировать отправителя электронной почты и тему из Outlook в 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

Строка 37 дает мне ошибку. Я пытался sheet.activate, sheet.select ни работал. Также я попробовал несколько решений, которые нашел в Интернете, но ни одно из них не помогло.

1 Ответ

0 голосов
/ 14 сентября 2018

Не могли бы вы обратиться к этому решению ниже: 

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

Для получения дополнительной информации см.

Добавление дополнительных строк в таблицу Excel с помощью VBscript

...