vba VBA将数据从未打开的CSV文件复制到工作表而不打开关闭的CSV
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/17602086/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA Copy data from an unopened CSV file to worksheet without opening closed CSV
提问by Lou
I believe I have a unique problem as I have not seen anything like it anywhere on the Internet.
我相信我有一个独特的问题,因为我在 Internet 上的任何地方都没有看到过类似的问题。
I am a business analyst/application developer and I want to automatically gather the data from other user's Excel CSV file on their personal computer without opening the file and disrupting them. Is there a way?
我是一名业务分析师/应用程序开发人员,我想从其他用户的个人计算机上的 Excel CSV 文件中自动收集数据,而无需打开文件并中断它们。有办法吗?
Here is the code I have so far:
这是我到目前为止的代码:
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
Like I said, I don't want the CSV file to open while they are working. I would like this behind the scenes so they can keep working while we gather the data.
就像我说的,我不希望 CSV 文件在他们工作时打开。我希望在幕后这样做,这样他们就可以在我们收集数据的同时继续工作。
I'm guessing my biggest hang up is that it's a CSV file, that or that the file is not open. If there's a way this can be done, please let me know. Currently, I am getting an out of range error.
我猜我最大的问题是它是一个 CSV 文件,或者那个文件没有打开。如果有办法做到这一点,请告诉我。目前,我收到超出范围的错误。
回答by chancea
Assuming that you want to just grab the data and put it in your current workbook. I recorded a macro using the Data -> Import Data method and in VBA and it seems to work with the CSV file closed:
假设您只想获取数据并将其放入当前工作簿中。我使用 Data -> Import Data 方法和 VBA 录制了一个宏,它似乎可以在关闭 CSV 文件的情况下使用:
Print to consecutive column:
打印到连续列:
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"))
.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
Print to consecutive row:
打印到连续行:
Here we have to add
这里我们要添加
Dim row As Integer
row = 1
On Error Resume Next
row = Range("A1").End(xlToRight).End(xlDown).row + 1
and then instead of: Destination:=Range("$A$1")
we use the row variable: Destination:=Range($A$" & row)
然后代替: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
This will grab all of the CSV data and put it in A1
you can change the $A$1
to whatever location you want. Of course you can change all of the other variables also, I just recorded the macro and edited the strConnection
variable to match the location you described in your question.
这将获取所有 CSV 数据并将其放入A1
您可以将其更改为$A$1
您想要的任何位置。当然,您也可以更改所有其他变量,我只是记录了宏并编辑了strConnection
变量以匹配您在问题中描述的位置。
Hopefully this is what you are looking for, if not let me know.
希望这就是你正在寻找的,如果不是让我知道。