Question

我希望使用这一连接样式的VBA代码来导入大量的CSV文件。当我使用连接向导时，它会以我需要的表格格式完全下载CSV，所以我希望避免使用字符串阅读器......

有没有办法做类似以下的事情，但没有创建永久连接？

Sub Macro1()

With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;T:\XYZ\KCross\Output\alpha.csv", Destination:=range("$B$2" _
    ))
    .name = "alpha_1"
    .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 = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
End Sub

Answer 1

我几天前就看到了这个。。。

' Merge data from multiple sheets into seperate sheets
Sub R_AnalysisMerger2()
    Dim WSA As Worksheet
    Dim bookList As Workbook
    Dim SelectedFiles As Variant
    Dim NFile As Long
    Dim FileName As String
    Dim Ws As Worksheet, vDB As Variant, rngT As Range
    Dim vFn, myFn As String

    Application.ScreenUpdating = False

    SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.csv*), *.csv*", MultiSelect:=True)
    If IsEmpty(SelectedFiles) Then Exit Sub

    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        FileName = SelectedFiles(NFile)
        vFn = Split(FileName, "\")
        myFn = vFn(UBound(vFn))
        myFn = Replace(myFn, ".csv", "")
        Set bookList = Workbooks.Open(FileName, Format:=2)
        Set WSA = bookList.Sheets(1)
        vDB = WSA.UsedRange
        bookList.Close (0)
        Set Ws = Sheets.Add(after:=Sheets(Sheets.Count))
        ActiveSheet.Name = myFn
        Ws.Range("a1").Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
    Next
    Application.ScreenUpdating = True

End Sub

' Merge data from multime files into one sheet.
Sub R_AnalysisMerger()
    Dim WSA As Worksheet
    Dim bookList As Workbook
    Dim SelectedFiles() As Variant
    Dim NFile As Long
    Dim FileName As String
    Dim Ws As Worksheet, vDB As Variant, rngT As Range

    Application.ScreenUpdating = False


    Set Ws = ThisWorkbook.Sheets(1)
    Ws.UsedRange.Clear
    'change folder path of excel files here
    SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.csv*), *.csv*", MultiSelect:=True)


    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        FileName = SelectedFiles(NFile)
        Set bookList = Workbooks.Open(FileName, Format:=2)
        Set WSA = bookList.Sheets(1)
        With WSA
            vDB = .UsedRange
            Set rngT = Ws.Range("a" & Rows.Count).End(xlUp)(2)
            If rngT.Row = 2 Then Set rngT = Ws.Range("a1")
            rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB

            bookList.Close (0)
        End With
    Next
    Application.ScreenUpdating = True
    Ws.Range("A1").Select

End Sub

Excel VBA - 无需数据连接即可导入CSV

1 个答案: