Filename toevoegen

[Bartjuh1990]

Ik heb 200 textbestanden ingeladen via een macro in excel, enkel moet hier nog een filename bij voor de duidelijkheid. Wat moet ik toevoegen om op de eerste rij de bestandsnaam (zonder .txt) te krijgen.

Sub LoadPipeDelimitedFiles()
    Dim idx As Integer
    Dim fpath As String
    Dim fname As String

    idx = 0
    fpath = "C:\Users\Bart\Dropbox\1 TUE\Master\Semester B\M1\Frisse scholen\3. Simulation\Results\results\"
    fname = Dir(fpath & "*.txt")
    While (Len(fname) > 0)
        idx = idx + 1
        ActiveSheet.Select
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
          & fpath & fname, Destination:=Range("A2"))
            .Name = "a" & idx
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileDecimalSeparator = "."
            .TextFileThousandsSeparator = " "
            .TextFileColumnDataTypes = Array(1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
            fname = Dir
                     
                       
           
            
        End With
        
  Wend
End Sub

Volgens mij is het simpel, alleen ik kom er niet snel uit.

 

[edmoor]

De rode regel op die plek.

fname = Dir(fpath & "*.txt")
While (Len(fname) > 0)
    [COLOR="#FF0000"]fname = Left(fname, Len(fname) - 4)[/COLOR]

 

[snb]

kan simpeler en sneller:

sub M_snb()
   c00 = "C:\Users\Bart\Dropbox\1 TUE\Master\Semester B\M1\Frisse scholen\3. Simulation\Results\results\"

   x0=createobject("wscript.shell").exec("cmd /c copy """ & c00 & "*.txt"" C:\samen.txt")
   workbooks.open "C:\samen.txt"
End Sub

NB. Je VBA-leven wordt een stuk gemakkelijker als je in foldernamen geen spaties gebruikt.

 

[dnties]

@snb: Let wel op dat standaard er geen schrijfrechten zijn op de hoofdmap van C: (sinds Vista al, geloof ik).
Dus mogelijk beter om een andere map te gebruiken, bijv. %temp% of zoiets.

Tijs.

 

[Bartjuh1990]

De rode regel op die plek.

fname = Dir(fpath & "*.txt")
While (Len(fname) > 0)
    [COLOR="#FF0000"]fname = Left(fname, Len(fname) - 4)[/COLOR]

Dan komt er een error.

EN hoe plaats ik fname dan in A1?

 

[edmoor]

Dan komt er een error.

En die is niet belangrijk?

 

[Bartjuh1990]

En die is niet belangrijk?

Dit geeft die fout aan.
.Refresh BackgroundQuery:=True

 

[edmoor]

Dat heeft niks met die rode regel zelf te maken. Laat dus maar eens zien hoe je het nu hebt.

 

[Bartjuh1990]

Dat heeft niks met die rode regel zelf te maken. Laat dus maar eens zien hoe je het nu hebt.

Sub LoadPipeDelimitedFiles()
Dim idx As Integer
Dim fpath As String
Dim fname As String

idx = 0
fpath = "C:\Users\Bart\Dropbox\1 TUE\Master\Semester B\M1\Frisse scholen\3. Simulation\Results\results\"
fname = Dir(fpath & "*.txt")
While (Len(fname) > 0)
fname = Left(fname, Len(fname) - 4)
idx = idx + 1
ActiveSheet.Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
& fpath & fname, Destination:=Range("A2"))
.Name = "a" & idx
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = " "
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
fname = Dir





End With

Wend
End Sub

 

[edmoor]

Daar komt dit helemaal niet in voor:
.Refresh BackgroundQuery:=True

 

[Bartjuh1990]

Daar komt dit helemaal niet in voor:
.Refresh BackgroundQuery:=True

Klopt, heb het gewijzigd om te kijken of het daar aan lag. True en False geven de fout.