VBA宏从CSV文件读取用户选择的字段名称

时间:2018-11-19 06:19:36

标签: excel vba excel-vba

我有一个sample.csv文件,其中包含四个字段/列:

  • 日期
  • 城市
  • 状态
  • 金额

下面是我的代码,它检索数据的所有四个字段:

Sub LoadFromFile()
    Dim fileName As String, folder As String

    folder = "d:\Sample.csv"
    fileName = ActiveCell.Value

    ActiveCell.Offset(1, 0).Range("A1").Select

    With ActiveSheet.QueryTables _
        .Add(Connection:="TEXT;" & folder & fileName, Destination:=ActiveCell)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

我的要求是仅显示三个字段/列:日期,城市和金额。我该怎么办?

2 个答案:

答案 0 :(得分:0)

       Sub CSVData()
        Dim con As ADODB.Connection
        Dim rs As ADODB.Recordset

        Set con = New ADODB.Connection
        Set rs = New ADODB.Recordset

        Dim currentDataFilePath As String
        Dim currentDataFileName As String
        Dim nextRow As Integer
        Dim emptystr As String
         '"H:\projectfiles\csv\", "Book.csv"
        currentDataFilePath = ("H:\projectfiles\csv\")
        currentDataFileName = ("Book.csv")
         emptystr = "NULL"


        con.Provider = "Microsoft.Ace.OLEDB.12.0"
        con.ConnectionString = "Data Source=" & currentDataFilePath & ";" & "Extended Properties=""text;HDR=Yes;FMT=Delimited;"""
        'MsgBox currentDataFilePath

        con.Open

        rs.Open "SELECT * FROM [" & currentDataFileName & "] ", con
        rs.MoveFirst
        'nextRow = Worksheets("Sheet3").UsedRange.Rows.Count + 1
        'Worksheets("Sheet3").Cells(nextRow, 1).CopyFromRecordset rs

        'MsgBox rs.RecordCount
        With rs
        Do Until .EOF

        'check the field is not null before process

         If Not IsNull(rs(0)) Then
         custordernum = rs(0)
         End If

         If Not IsNull(rs(1)) Then
        ContactNAme = "" & Replace(rs(1), "'", " ")

        Else
        ContactNAme = emptystr
        End If

        If Not IsNull(rs(2)) Then
        colladd1 = "" & Replace(rs(2), "'", " ")
        Else
        colladd1 = emptystr
        End If
        MsgBox colladd1
        .MoveNext
        Loop
         End With


        rs.Close
        con.Close
        End Sub

答案 1 :(得分:0)

这是您完全按照自己的意愿做的选择,因此您可以复制并更改为您的规范

       Sub CSVDataBok()
        Dim con As ADODB.Connection
        Dim rs As ADODB.Recordset

        Set con = New ADODB.Connection
        Set rs = New ADODB.Recordset

        Dim currentDataFilePath As String
        Dim currentDataFileName As String
        Dim nextRow As Integer
        Dim emptystr As String
         '"H:\projectfiles\csv\", "Book.csv"
        currentDataFilePath = ("H:\resources\")
        currentDataFileName = ("Book2.csv")
         emptystr = "NULL"


        con.Provider = "Microsoft.Ace.OLEDB.12.0"
        con.ConnectionString = "Data Source=" & currentDataFilePath & ";" & "Extended Properties=""text;HDR=Yes;FMT=Delimited;"""
        'MsgBox currentDataFilePath

        con.Open

        rs.Open "SELECT Date,City,State,Amount FROM [" & currentDataFileName & "] ", con
        rs.MoveFirst
        nextRow = Worksheets("Sheet3").UsedRange.Rows.Count + 1
        Worksheets("Sheet3").Cells(nextRow, 1).CopyFromRecordset rs

        rs.Close
        con.Close
        End Sub