Variable bestandnaam importeren

[Chella]

Hallo allemaal,

Sinds kort ben ik de wondere wereld van excel en met name VB ingedoken.
Ik kom er nu alleen niet helemaal uit

Ik wil een macro maken die een .csv bestand importeert, maar het .csv bestand heeft deels een variabele naam. Het deel dat vast is, is: U:\lijsten\******\Bellijst-1-20110610 (dd vandaag zeg maar, maar ook dat wijzigt dagelijks)
Daarachter dus de code voor de variabele naam, maar ik kom er helaas niet uit.

Dit is mijn geklooi tot nu toe:

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;U:\lijsten\******\Bellijst-1\" & varNaam &
, Destination:=Range("A3"))
.Name = "Bellijst-1-20110610-050438-met-telnr"

 

[Mark xl]

Hoi Chella

Wat ik me afvroeg bij het maken van een voorbeeld functie, was of er meerdere bestanden bestaan per datum.

Ik heb een functie gemaakt die alle bestanden zoekt in de map met csv's die voldoen aan de criteria:
-"mapnaam" plus het begin van de bestandsnaam,
- de datumnotatie in "ddmmjjjj"
Me die gevenens ben ik de map gaan afspeuren naar bestanden die voldoen aan die criteria

als dat meerdere bestanden zijn pakt deze functie de eerste waarde die terugkomt

Gebruik m zo:

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & GetTextFileName, _
                                 Destination:=Range("A3"))

Private Function GetTextFileName() As String
'2011 Mark xl
Dim strDatetoday As String
Dim strPath As String
Dim strFound As String

Dim KnownPart As String

Dim FoundFiles As Variant
Dim files As Long

    strDatetoday = Format(Date, "yyyymmdd")
    strPath = "U:\lijsten\******\Bellijst-1-"
    
    KnownPart = strPath & strDatetoday
    
    ReDim FoundFiles(1 To 1)
    
    strFound = Dir(KnownPart & "*.*")
    
    If strFound = "" Then
        MsgBox "er zijn geen bestanden gevonden", vbExclamation
        Exit Function
    End If
    
    Do
        'bij meerdere bestanden worden deze opgeslagen in een array
        files = files + 1
        ReDim Preserve FoundFiles(1 To files)
        FoundFiles(files) = strFound
        strFound = Dir()
    Loop Until strFound = ""
    
    GetTextFileName = FoundFiles(1)
    
    If files > 1 Then
        MsgBox "er zijn meerdere bestanden gevonden " & _
                "die aan de zoekcriteria voldoen", _
                vbExclamation, "Let op!"
    End If
    
End Function

 

[Chella]

Hallo Mark,

Bedankt voor je reactie

Het gaat om 9 .csv bestanden die geimporteerd worden op elk een ander tabblad.
Bestandlocatie:
U:\lijsten\******\Bellijst-1-20110610-050438-met-telnr -> in blad 1
U:\lijsten\******\Bellijst-2-20110610-050438-met-telnr -> in blad 2
etc

De bestandnamen zijn dus wel dagelijks uniek. Ga even stoeien met die van jou!

 

[Mark xl]

Chella, ik heb iets niet helemaal goedgedaan in de bovenstaande post.
ik vergat het PAD van het bestand terug te geven. en daarvoor moest ik de functie iets aanpassen (leesbaarder maken)

Vervolgens was het een peuleschil(peulen..?) om gelijk die csvtabellen aan te maken

Sub TestTextophalen()
Dim i As Long

    For i = 1 To 9
        Sheets.Add
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & GetTextFileName(i), _
                                 Destination:=Range("A3"))
            .Name = "csv" & CStr(i)
            'de rest van de opties
            .Refresh
        End With
    Next

End Sub

Private Function GetTextFileName(FileNumber As Long) As String
'2011 Mark xl
'Parameter:     Het nummer van het bestand bv 2 voor [Bellijst-2-..]
Dim strDatetoday As String
Dim strPath As String
Dim strFound As String
Dim strFilePart As String
Dim FoundFiles As Variant
Dim files As Long

    strPath = "U:\lijsten\******\"
    strDatetoday = Format(Date, "yyyymmdd")
    strFilePart = "Bellijst-" & CStr(FileNumber) & "-" & strDatetoday
    'Matrix voor gevonden bestanden:
    ReDim FoundFiles(1 To 1)
    'resultaat directory search:
    strFound = Dir(strPath & strFilePart & "*.*")
    
    If strFound = "" Then
        MsgBox "er zijn geen bestanden gevonden", vbExclamation
        Exit Function
    End If
    
    Do
        'Bestand opslaan in array
        files = files + 1
        ReDim Preserve FoundFiles(1 To files)
        FoundFiles(files) = strFound
        strFound = Dir()
        
    Loop Until strFound = ""
    
    'retourneer het pad en het bestand
    GetTextFileName = strPath & FoundFiles(1)
    'laat gebruiker weten of er meerdere bestanden zijn gevonden
    If files > 1 Then
        MsgBox "er zijn meerdere bestanden gevonden " & _
                "die aan de zoekcriteria voldoen", _
                vbExclamation, "Let op!"
    End If
    
End Function

 

[Chella]

Hoi Mark,

Ik ga er deze week weer even mee aan de slag. Bedankt voor je hulp!