Я не могу получить то, что у меня внутри, с помощью моего кода - PullRequest
Новая
       6

Я не могу получить то, что у меня внутри, с помощью моего кода

0 голосов
/ 29 мая 2019

Я не могу получить внутреннюю часть моей папки задач на моем внешнем виде с моим кодом.Ребята, вы знаете какие-нибудь проблемы здесь?

Проблема, которую я увидел, заключается в том, что она не входит в мой цикл For. 

Private Sub CommandButton1_Click()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer


Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Task")


i = 1

For Each OutlookMail In Folder.Items
If OutlookMail.ReceivedTime >= Range(“date_received”).Value Then
Range(“Sender”).Offset(i, 0).Value = OutlookMail.SenderName
Range(“Sender”).Offset(i, 0).Columns.AutoFit
Range(“Sender”).Offset(i, 0).VerticalAlignment = xlTop
Range(“Body”).Offset(i, 0).Value = OutlookMail.Body
Range(“Body”).Offset(i, 0).Columns.AutoFit
Range(“Body”).Offset(i, 0).VerticalAlignment = xlTop

i = i + 1
End If
Next OutlookMail

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

1 Ответ

0 голосов
/ 29 мая 2019

Я только что изменил несколько вещей в вашем коде, но у меня все работает нормально 

Option Explicit
Private Sub CommandButton1_Click()

    Dim OutlookApp As Outlook.Application
    Dim OutlookNamespace As Namespace
    Dim Folder As MAPIFolder
    Dim OutlookMail As Variant
    Dim i As Integer

    Set OutlookApp = New Outlook.Application
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Bienvenidas")

    i = 2

    With ThisWorkbook.Sheets("MySheet") 'Change MySheet for your sheet name, and ALWAYS reference sheets and workbooks.
        For Each OutlookMail In Folder.Items
            If OutlookMail.ReceivedTime >= .Range("C1") Then
                With .Cells(i, 1)
                    .Value = OutlookMail.SenderName
                    .Columns.AutoFit
                    .VerticalAlignment = xlTop
                End With
                With .Cells(i, 2)
                    .Value = OutlookMail.Body
                    .Columns.AutoFit
                    .VerticalAlignment = xlTop
                End With
                i = i + 1
            End If
        Next OutlookMail
    End With

    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing

End Sub

Вместо того, чтобы использовать диапазоны и затем смещение, перейдите к ячейке, в которой есть диапазон отправителя, тело и дата, и укажите их напрямую.

Единственное, что приходит мне в голову, это папка «Задачи» внутри вашей папки «Входящие»? Оттуда может прийти ошибка.

Редактировать: Код для проверки всех ваших подпапок в папке входящих сообщений: 

Sub Loop_folders_of_inbox()

    Dim ns As Outlook.Namespace
    Dim myfolder As Outlook.Folder
    Dim mysubfolder As Outlook.Folder
    Dim OutlookApp As Outlook.Application

    Set OutlookApp = New Outlook.Application
    Set ns = OutlookApp.GetNamespace("MAPI")
    'Get the default inboxfolder
    Set myfolder = ns.GetDefaultFolder(olFolderInbox)
    'Loop through each folder and display name of the folder
    For Each mysubfolder In myfolder.Folders
        Debug.Print mysubfolder.Name
    Next mysubfolder

End Sub

Редактировать 2: каждое слово из тела в отдельном столбце: 

Dim arrBody
Dim j As Long

arrBody = Split(OutlookMail.Body, " ") 'words delimited by space
For j = LBound(arrBody) To UBound(arrBody)
    .Cells(i, j + 1) = arrBody(j) 'use j + 1 because arrays built from Space function start at index 0
Next j
...