Импорт файлов CSV с использованием таблицы запросов VBA удаляет верхние строки данных

Question

Это мой код

Sub ImportCSVFile(xFileName As String, ByRef xTargetRange As Range)

    With xTargetRange.Parent.QueryTables.Add("TEXT;" & xFileName, xTargetRange)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Этот блок кода работает нормально, но проблема в том, что когда вы хотите импортировать данные, например, в диапазон (A4), данные (верхние строки) будут удалены (содержание и форматы). Вопрос в том, можно ли сохранить эти данные?

Answer 1

Попробуйте,

Sub test()
    Dim vFile As Variant
    Dim s As String
    
    vFile = Application.GetOpenFilename("ExcelFile *.txt,*.txt;*.csv", _
       Title:="Select CSV file", MultiSelect:=False)

    If TypeName(vFile) = "Boolean" Then Exit Sub
    
    s = vFile
    
    ImportCSVFile s, Range("a4")

End Sub


Sub ImportCSVFile(xFileName As String, ByRef xTargetRange As Range)
    Dim WbCSV As Workbook
    Dim vDB As Variant
    
Application.ScreenUpdating = False
    
    Set WbCSV = Workbooks.Open(Filename:=xFileName, Format:=2)
    
    With WbCSV.Sheets(1)
        vDB = .UsedRange
    End With

    WbCSV.Close (0)

    xTargetRange.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB

Application.ScreenUpdating = True
End Sub

    enter code here