Bestanden inlezen

[Schelledraad]

Ik heb de navolgende code

Cel CR1 is variabel ( .CSV, .XLS, . XLSB, .XLSM, .XLSX

Sub DataBestandenHalen()
Dim AntWrd As Variant
Dim mTmp As Variant
Dim sMp As String
Dim MyNumber
    sMp = ThisWorkbook.Path & Application.PathSeparator
    
    'bestandsnamen ophalen in dezelfde map
    ReDim mTmp(1 To 1)
    AntWrd = Dir(sMp & "*" & [cr1])
    Do Until AntWrd = ""
        If AntWrd <> ThisWorkbook.Name Then
            If mTmp(UBound(mTmp)) <> "" Then
                ReDim Preserve mTmp(1 To UBound(mTmp) + 1)
            End If
            mTmp(UBound(mTmp)) = AntWrd
        End If
        AntWrd = Dir
    Loop

)
Dat werkt prima, alleen als ik .XLS kies worden ook de bestanden met extentie X, B en M opgehaald.
Is dit te verhelpen ?

 

[edmoor]

Die punt staat ook daadwerkelijk bij de waarde in CR1?
Geen probleem hier.
Plaats anders een voorbeeld documentje.

 

[Schelledraad]

Ja

 

[edmoor]

Geen probleem hier.
Plaats dan een voorbeeld documentje.

 

[Schelledraad]

Hier het bestand in de DIR staan dus allemaal bestanden met verschillende extenties

 

[edmoor]

Ook met dat bestand geen enkel probleem.
Alleen de gekozen extensie wordt gebruikt.
Geen idee waarom het bij jou een probleem geeft.

 

[Schelledraad]

Hmmm, tsja dat zal ik dan moeten onderzoeken. Bedankt iig

 

[HSV]

Het probleem doet zich bij mij ook voor.
Veranderen in:

ReDim mTmp(1 To 1)
    AntWrd = Dir(sMp & "*")
    Do Until AntWrd = ""
    If UCase(CreateObject("Scripting.FileSystemObject").GetExtensionName(AntWrd)) = Replace([cr1], ".", "") Then
        If AntWrd <> ThisWorkbook.Name Then
            If mTmp(UBound(mTmp)) <> "" Then
                ReDim Preserve mTmp(1 To UBound(mTmp) + 1)
            End If
            mTmp(UBound(mTmp)) = AntWrd
        End If
   End If
        AntWrd = Dir
    Loop