Spaties uit array halen

[Roeland035]

Beste forumleden,

Met de volgende code haal ik bepaalde data uit een email body en plaats ik die in excel.

Sub Naar_configuratieblad()

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

Set olItem = Application.ActiveExplorer().Selection(1)
    With GetObject("C:\Users\r.vanhouten\Documents\Specifications mk1 XXXXXXX rev -v2.2.xlsx")
           sn = Filter(Split(Split(olItem.Body, "Offerrequest Qimarox Vertical Conveyors")(1), vbCrLf), ": ", True)
           [COLOR="#FF0000"]sn1[/COLOR] = Filter(Split(Split(olItem.Body, "Offerrequest Qimarox Vertical Conveyors")(1), vbCrLf), ": ", False)
           .Sheets("Email Data").Cells(1, 1).Resize(UBound(sn) + 1) = .Application.Transpose(sn)
           '.Sheets("Email Data").Cells(1, 2).Resize(UBound(sn1) + 1) = .Application.Transpose([COLOR="#FF0000"]sn1[/COLOR])
           '.Sheets("General").Activate
       .Application.Visible = True
       .Windows(1).Visible = True
    End With
 End Sub

In de array van sn1 komen helaas spaties te staan waardoor ik bij de functie .Application.Transpose maarliefst 2 witregels krijg tussen elk stukje data. Mijn wens is om deze witregels teniet te doen.

Heeft iemand een oplossing?


Bovenstaande afbeelding geeft een stukje van de array weer.

 

[Roeland035]

Uiteraard blijf ik zelf niet stil zitten en heb ik na wat stoeien eindelijk een oplossing gevonden.
Misschien niet de meest ideale, maar het werkt!

Sub Naar_configuratieblad()

Dim currentExplorer As Explorer
Dim Selection As Selection
Dim olItem As Outlook.MailItem
Dim sn2()
Dim sn1
Dim i As Integer
Dim x

x = Null

Set olItem = Application.ActiveExplorer().Selection(1)
    With GetObject("C:\Users\r.vanhouten\Documents\Specifications mk1 XXXXXXX rev -v2.2.xlsx")
           sn = Filter(Split(Split(olItem.Body, "Offerrequest Qimarox Vertical Conveyors")(1), vbCrLf), ": ", True)
           sn1 = Filter(Split(Split(olItem.Body, "Offerrequest Qimarox Vertical Conveyors")(1), vbCrLf), ": ", False)
                For Each x In sn1
                    If Not x & "" = "" Then
                        ReDim Preserve sn2(i + 1)
                        sn2(i) = x
                        i = i + 1
                    End If
                Next
           .Sheets("Email Data").Cells(1, 1).Resize(UBound(sn) + 1) = .Application.Transpose(sn)
           .Sheets("Email Data").Cells(1, 2).Resize(UBound(sn2) + 1) = .Application.Transpose(sn2)
           '.Sheets("General").Activate
       .Application.Visible = True
       .Windows(1).Visible = True
    End With
 End Sub

 

[edmoor]

Kijk ook eens naar de functie Replace(x, " ", "")