VBA将数据从未打开的CSV文件复制到工作表,而无需打开关闭的CSV [英] VBA Copy data from an unopened CSV file to worksheet without opening closed CSV
问题描述
我相信我有一个独特的问题,因为我在互联网上的任何地方都没有看到类似的东西.
I believe I have a unique problem as I have not seen anything like it anywhere on the Internet.
我是一名业务分析师/应用程序开发人员,我希望在其个人计算机上自动从其他用户的Excel CSV文件中收集数据,而无需打开该文件并破坏它们.有办法吗?
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?
这是我到目前为止的代码:
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
就像我说的那样,我不希望CSV文件在它们工作时打开.我希望在后台进行此操作,以便他们在收集数据时可以继续工作.
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.
推荐答案
假定您只想获取数据并将其放入当前工作簿中.我使用Data-> Import Data方法并在VBA中记录了一个宏,它似乎可以在CSV文件关闭的情况下工作:
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:
打印到连续的列:
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)
and then instead of: Destination:=Range("$A$1")
we use the row variable: 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
变量以匹配您在问题中描述的位置.
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.
希望这是您要寻找的,如果没有让我知道.
Hopefully this is what you are looking for, if not let me know.
这篇关于VBA将数据从未打开的CSV文件复制到工作表,而无需打开关闭的CSV的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!