Ошибка «Неверная или неквалифицированная ссылка» при передаче в ExcelSheet - PullRequest
0 голосов
/ 28 апреля 2020

Я получаю сообщение об ошибке при передаче листа Excel в Sub GetDate. Приведенный ниже код перебирает электронные письма Outlook и извлекает данные из вложенных слов в лист Excel, который создается во время выполнения. Все это прекрасно работает. К тому времени, когда код попадает в GetDate, лист Excel открыт. Я хочу передать его в другую подпрограмму, поскольку код становится беспорядочным и выполнить некоторую постобработку с данными. Я ошибаюсь? Я относительно новичок в работе с Outlook VBA и обращаюсь к библиотеке объектов Excel. Ниже приведен код (я определяю и создаю лист Excel в верхней части, а затем передаю его в подпункт «Получить дату» внизу)

Sub EmailStatsV3()         'I pull the emails directly from MISO Ontca (Must select folder first before running else you
    Dim Item As Object     'get run time error
    Dim varOutput() As Variant
    Dim lngcount As Long
    Dim xlApp As Excel.Application
    Dim xlSht As Excel.Worksheet
    Dim ShareInbox As Outlook.MAPIFolder
    Dim olNs As Outlook.NameSpace
    Dim olRecip As Outlook.Recipient
    Dim SubFolder As Object
    Dim Atmt As Attachment
    Dim wrd As Object
    Dim wrdDoc As Object
    Dim j  As Integer
    j = 1
    Dim tempdate As Date
    temp_date = Date - 12

    Set xlApp = New Excel.Application
    Set xlSht = xlApp.Workbooks.Add.Sheets(1)

    Set olNs = Application.GetNamespace("MAPI")
    Set olRecip = olNs.CreateRecipient("xyz@abc.ca") '// Owner's Name or email address
    Set SubFolder = Application.ActiveExplorer.CurrentFolder
    ReDim varOutput(1 To SubFolder.Items.Count, 1 To 4)

    ' Loop through Emails containing "TOI" in subject and Word Attachment
    For Each Item In SubFolder.Items
        If TypeName(Item) = "MailItem" Then
            If Item.SentOn >= temp_date Then     'Filters for emails sent past a set Date
                For Each Atmt In Item.Attachments
                    If Not Atmt Is Nothing Then
                        If InStr(Atmt.FileName, "doc") And InStr(Item.Subject, "TOI") Then

                            On Error Resume Next

                            FileName = "abc" & Atmt.FileName
                            Atmt.SaveAsFile FileName

                            'gets the Word doc object
                            Set wrd = GetObject(FileName)
                            'Set wrdDoc = wrd.Application
                            'wrdDoc.Visible = True
                            'Read desired data from first table in Word Doc into Excel
                            With wrd.Tables(1)
                                xlSht.Cells(j, 1).Value = WorksheetFunction.Clean(.Cell(2, 2).Range.Text)
                                xlSht.Cells(j, 2).Value = WorksheetFunction.Clean(.Cell(3, 2).Range.Text)
                            End With
                            j = j + 1

                        End If
                    End If
                Next
            End If
        End If
    Next

    xlApp.Visible = True
    'Pass sheet into sub to get date GetDate(xlSht)
    Call GetDate(xlSht)

    Set olNs = Nothing
    Set olRecip = Nothing
    Set ShareInbox = Nothing
    Set SubFolder = Nothing


End Sub
'Parse string to get (Starting - Endind Date EST)
Public Sub GetDate(xlSheet As Excel.Worksheet)
xlSht.Cells(2, 3).Value = WorksheetFunction.Clean(.Cell(3, 2).Range.Text)

End Sub

Спасибо,

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