Question

我相信我有一个独特的问题，因为我在互联网上的任何地方都没有看到类似的东西。

我是业务分析师/应用程序开发人员，我希望自动从其个人计算机上的其他用户的Excel CSV文件中收集数据，而无需打开文件并中断它们。有办法吗？

这是我到目前为止的代码：

Option Explicit

Dim MyDocuments As String, strFileName, myToday, origWorkbook, origWorksheet, strConnection
Dim row As Integer

Private Sub btnStart_Click()
    MyDocuments = Environ$("USERPROFILE") & "\My Documents"
    myToday = Format(Date, "mmddyy")
    strFileName = "DataFile" & myToday & ".csv"
    strConnection = "TEXT;" & MyDocuments & "\DataFolder\" & strFileName
    origWorksheet = "DataFile" & myToday

    row = 1
    On Error Resume Next
    row = Range("A1").End(xlDown).row + 1

    With ActiveSheet.QueryTables.Add(Connection:=strConnection, Destination:=Range("$A$" & row))
        .Name = "temp"
        .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)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

就像我说的，我不希望CSV文件在工作时打开。我希望在幕后工作，以便他们在收集数据时继续工作。

我猜我最大的问题是它是一个CSV文件，或者该文件没有打开。如果有办法可以做到，请告诉我。目前，我的范围错误。

Answer 1

假设您只想抓取数据并将其放入当前的工作簿中。我使用数据记录了一个宏 - ＆gt;导入数据方法和在VBA中它似乎与CSV文件关闭：

打印到连续列：

Sub Macro1()

    Dim MyDocuments, strFileName, myToday, file, strConnection As String

    MyDocuments = Environ$("USERPROFILE") & "\My Documents"
    myToday = Format(Date, "mmddyy")
    strFileName = "DataFile" & myToday & ".csv"

    strConnection = "TEXT;" & MyDocuments & "\DataFolder\" & strFileName
    With ActiveSheet.QueryTables.Add(Connection:= _
         strConnection, Destination:=Range("$A$1"))
        .Name = "temp"
        .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)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

打印到连续行：

我们必须添加

Dim row As Integer
    row = 1
    On Error Resume Next

    row = Range("A1").End(xlToRight).End(xlDown).row + 1

然后代替：Destination:=Range("$A$1") 我们使用行变量：Destination:=Range($A$" & row)

Sub Macro1()

    Dim MyDocuments, strFileName, myToday, file, strConnection As String

    MyDocuments = Environ$("USERPROFILE") & "\My Documents"
    myToday = Format(Date, "mmddyy")
    strFileName = "DataFile" & myToday & ".csv"

    Dim row As Integer
    row = 1
    On Error Resume Next
    row = Range("A1").End(xlDown).row + 1

    strConnection = "TEXT;" & MyDocuments & "\DataFolder\" & strFileName
    With ActiveSheet.QueryTables.Add(Connection:= _
         strConnection, Destination:=Range("$A$" & row))
        .Name = "temp"
        .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)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

这将获取所有CSV数据并将其放入A1您可以将$A$1更改为您想要的任何位置。当然你也可以改变所有其他变量，我只记录了宏并编辑了strConnection变量以匹配你在问题中描述的位置。

希望这就是你要找的，如果不让我知道的话。

VBA将未打开的CSV文件中的数据复制到工作表而不打开关闭的CSV

1 个答案: