lundi 20 avril 2015

Adding filename while importing txt file in VBA

I just wrote a program that imports .txt files to excel.

I try to import the filename (custName) to the first row of the sheet and the .txt to start below that. My filename is imported lagging 2 columns behind the associated .txt file and the first imported filename is always missing.

Am I missing some sort of offset or is it something with how the first for loop is running?

Function import(shtraw)

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
    .Show
    .AllowMultiSelect = False
    If .SelectedItems.Count = 0 Then
        MsgBox "You did not select a folder"
        Exit Function
    End If
    MyFolder = .SelectedItems(1)
End With

Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
Set folderObj = fileSystemObject.getfolder(MyFolder)

shtraw.Select
For Each fileObj In folderObj.Files 'loop through files

If (fileSystemObject.GetExtensionName(fileObj.Path) = "txt") Then

    If Not fileObj.Attributes And 2 Then
        arrFileName = Split(fileObj.Path, "\")
        Path = "TEXT:" & fileObj.Path
        filename = arrFileName(UBound(arrFileName))

        'Get the filename without the.mtmd
        CustName = Mid(filename, 1, InStr(filename, ".") - 1)
        shtraw.range("$A$1").value = CustName

        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fileObj.Path, Destination:=range("$A$2"))
            .name = filename
            .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 = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    End If 'end if hidden if statement
    End If 'end of txt
Next fileObj 'close loop

range("$A$1:$B$1").Delete shift:=xlToLeft

End Function

Aucun commentaire:

Enregistrer un commentaire