.Windows(1).Visible = True (Subscript out of range in nieuwe office)

[Roeland035]

Best forumleden,

Ik heb een macro dat gegevens van een tabel uit een email automatisch overzet in een excel bestand.
Dit werkt naar behoren, alleen ik probeerde zojuist de macro te installeren bij een werknemer die met de 2016 versie van Outlook en Excel werkt. Zodra ik bij hem de macro wou runnen, dan geeft hij een error: Subscript out of range bij het stukje code .Windows(1).Visible = True. Bij office 2010 werkt het allemaal wel.

De macro is als volgt:

Public conveyor As String

Sub Search_Conveyor()

Dim currentExplorer As Explorer
Dim Selection As Selection
Dim olItem As Outlook.MailItem
Dim sText As String

Set olItem = Application.ActiveExplorer().Selection(1)
sText = olItem.Body
      Set Reg1 = New RegExp
       
    With Reg1
        .Pattern = "Conveyor type:+\s*(\w*)"
        .Global = True
    End With
    
    If Reg1.Test(sText) Then
        Set M1 = Reg1.Execute(sText)
        For Each Match In M1
            If Match.SubMatches.Count > 0 Then
                For Each subMatch In Match.SubMatches
                    If subMatch = "mk1" Then
                        conveyor = subMatch
                        Call Prorunner_naar_configuratieblad
                        Exit Sub
                    ElseIf subMatch = "mk5" Then
                        conveyor = subMatch
                        Call Prorunner_naar_configuratieblad
                        Exit Sub
                    ElseIf subMatch = "mk9" Then
                        conveyor = subMatch
                        Call Prorunner_naar_configuratieblad
                        Exit Sub
                    ElseIf subMatch = "mk10" Then
                        conveyor = subMatch
                        Call Prorunner_naar_configuratieblad
                        Exit Sub
                    End If
                Next subMatch
            End If
        Next
    End If
NotFound:
    MsgBox ("Could not find a Salesquote." & vbCrLf & _
    "Did you select the correct email?" & vbCrLf & _
    vbCrLf & _
    "Current selected email: " & vbCrLf & _
    olItem)
End Sub

Sub Prorunner_naar_configuratieblad()

Dim currentExplorer As Explorer
Dim Selection As Selection
Dim olItem As Outlook.MailItem
Dim myPath As String
Dim myExt As String
Dim myFile As String
Dim DataNew()
Dim remarksNew()
Dim LDate As Date
Dim worksh As Integer
Dim worksheetexists As Boolean
Dim Item As Variant
worksheetexists = False

myPath = "R:\PRORUNNER " & conveyor & "\Configuratieblad\"
myExt = "Specifications " & conveyor & "*.xlsx"
myFile = Dir(myPath & myExt)
If myFile = "" Then
    GoTo NotFound
End If
Set olItem = Application.ActiveExplorer().Selection(1)
    With GetObject(myPath & myFile)
        worksh = .Sheets.Count
        For y = 1 To worksh
            If .Worksheets(y).Name = "Email Data" Then
                worksheetexists = True
                Exit For
            End If
        Next y
        
        If worksheetexists = False Then
            MsgBox "The configurationfile for the " & conveyor & " does not support this action yet"
            Exit Sub
        End If
           
        LDate = olItem.ReceivedTime
            headers = Filter(Split("~" & Replace(Split(Split(olItem.Body, "Company Data:")(1), "Special remarks")(0), vbCrLf, "~: "), ": "), "~", 0)
            remarks = Split(Split(olItem.Body, "Special remarks: ")(1), vbCrLf)
            Data = Filter(Split(Replace(Split(Split(olItem.Body, "Company Data:")(1), "Special remarks")(0), vbCrLf, "~: "), ": "), "~", 1)
                For i = LBound(Data) To UBound(Data)
                    Data(i) = Replace(Data(i), Chr(9), "")
                    Data(i) = Replace(Data(i), " ~", "")
                    Data(i) = Replace(Data(i), "~", "")
                    Data(i) = Replace(Data(i), "*", "")
                Next i
                For s = LBound(remarks) To UBound(remarks)
                    remarks(s) = Replace(remarks(s), "*", "")
                    remarks(s) = Replace(remarks(s), Chr(9), "")
                Next s
                For Each x In Data
                    If Not x & "" = "" Then
                         ReDim Preserve DataNew(j + 1)
                         DataNew(j) = x
                         j = j + 1
                     End If
                Next x
                For Each Z In remarks
                    If Not Z & "" = "" Then
                        ReDim Preserve remarksNew(p + 1)
                        remarksNew(p) = Z
                          p = p + 1
                    End If
                Next Z
            .Sheets("Email Data").Cells(2, 1).Resize(UBound(headers) + 1) = .Application.Transpose(headers)
            .Sheets("Email Data").Cells(1, 2).Resize(UBound(DataNew) + 1) = .Application.Transpose(DataNew)
            .Sheets("Email Data").Range("B1").Insert Shift:=xlDown
            .Sheets("Email Data").Range("E14").Value = LDate
            .Sheets("Email Data").Range("B14").Insert Shift:=xlDown
            .Sheets("Email Data").Range("A50").Value = "Special remarks"
            On Error GoTo Nextone
            .Sheets("Email Data").Range("B50").Value = remarksNew
Nextone:
            .Sheets("General").Activate
       .Application.Visible = True
[COLOR="#FF0000"]       .Windows(1).Visible = True[/COLOR]
    End With
Exit Sub
NotFound:
    MsgBox ("Configuration sheet could not be found.")
 End Sub

In het rood (helemaal onderin) staat het stukje code in het rood aangegeven.

De macro opent twee excel bestanden. Eentje genaamd "Excel" en de ander is het bestand waar de gegevens in overgezet moeten worden. Helaas wil het bestand niet openen naar behoren (excel bestand zonder inhoud) en vervolgens geeft hij de error zoals die in de titel staat vermeld.

Heeft iemand enig idee wat er mis kan zijn?

Ik kan helaas niet het excel bestand tonen, maar het gaat er ook meer om dat de macro het bestand bestand zichtbaar dient te maken.

 

[Roeland035]

Ik ben een topic tegengekomen met hetzelfde probleem. De oplossing met xlApp heeft mij hierbij geholpen als workaround.
Bron: https://social.msdn.microsoft.com/F...-does-not-work-with-excel-2016?forum=exceldev

 

[snb]

Mij lijkt die hele regel overbodig.