1

インターネットのどこにも似たようなものを見たことがないので、私には独特の問題があると思います。

私はビジネス アナリスト/アプリケーション開発者であり、他のユーザーの PC 上の 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 ファイルであること、またはファイルが開いていないことだと思います。これを行う方法があれば、私に知らせてください。現在、範囲外エラーが発生しています。

4

1 に答える 1

4

データを取得して現在のワークブックに配置したいとします。Data -> Import Data メソッドと 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変数を編集して、質問で説明した場所に一致させました。

うまくいけば、これはあなたが探しているものです。そうでなければ、私に知らせてください.

于 2013-07-11T20:16:18.820 に答える