Excel 创建VBA脚本以自动化数据上载和转换

我正在处理模拟的数据。模拟中的监视器是CSV文件，但每个模拟大约有20个，在Excel中上载每个监视器并将值转换为十进制数字类型很麻烦

我目前有一个VBA模块，可以自动上载这些值：

  '''  Sub Macro4()

ActiveWorkbook.Queries.Add Name:="oil-produced", Formula _
    := _
    "let" & Chr(13) & "" & Chr(10) & "    Source = Table.FromColumns({Lines.FromBinary(File.Contents(""C:\Users\user\Documents\run6\results\oil-produced.out""), null, null, 1252)})," & Chr(13) & "" & Chr(10) & "    #""Split Column by Delimiter"" = Table.SplitColumn(Source, ""Column1"", Splitter.SplitTextByDelimiter("" "", QuoteStyle.Csv), {""Column1.1"", ""C" & _
    "olumn1.2"", ""Column1.3""})," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(#""Split Column by Delimiter"",{{""Column1.1"", type number}, {""Column1.2"", type number}, {""Column1.3"", type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
    "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""oil-produced"";Extended Properties=""""" _
    , Destination:=Range("$A$1")).QueryTable
    .CommandType = xlCmdSql
    .CommandText = Array("SELECT * FROM [oil-produced]")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .ListObject.DisplayName = "oil_produced"
    .Refresh BackgroundQuery:=False
End With
Application.Run "getUnits"
  End Sub

数据文件位于文件夹C:\Users\user\Documents\run6\results\oil producted中，该数据文件称为oil producted

我必须调用几个像这样的数据文件以及这些文件正在更改的文件夹。我希望能够在宏的开头参数化文件夹和数据文件名，这样我就可以在不更正每个查询的情况下轻松更改文件位置，并创建一个for循环来循环数据文件，这样子文件就不会那么长和庞大

我尝试通过将文件夹名设置为字符串并在工作簿查询中替换它来实现这一点；但是，我得到一个错误，指出提供的文件路径必须是有效的绝对路径

---

有人对其他方法有什么建议吗？

如果我能告诉你的话，我会尝试类似的方法

Function CompleteString(strPath As String, strFileName As String, _
                    Optional blnAdditionalQuotes = True)
    CompleteString = IIf(blnAdditionalQuotes, Chr(34), vbNullString) & _
                        "\" & strFileName & _
                        IIf(blnAdditionalQuotes, Chr(34), vbNullString)
End Function

然后像这样使用

---

…“File.Contents”（&CompleteString（“C:\Users\user\Documents\run6\results\oil producted”，“oil producted.out”）&），null，null“…

我不知道您的查询信息在哪里，所以我设置了一个表来存储它，如下所示：

表名称：

TableParams

检查代码注释并根据需要进行调整

代码：

Option Explicit

Public Sub ProcessQueries()

    Dim sourceTable As ListObject
    Dim sourceListRow As ListRow

    Dim queryName As String
    Dim sourceFolder As String
    Dim sourceFileName As String
    Dim targetSheetName As String
    Dim targetCellAddr As String

    Set sourceTable = Range("TableParams").ListObject

    ' Loop through each row
    For Each sourceListRow In sourceTable.ListRows


        queryName = sourceListRow.Range.Cells(1, 1).Value ' -> ' Second argument of cells is the table's column number
        sourceFolder = sourceListRow.Range.Cells(1, 2).Value
        sourceFileName = sourceListRow.Range.Cells(1, 3).Value
        targetSheetName = sourceListRow.Range.Cells(1, 4).Value
        targetCellAddr = sourceListRow.Range.Cells(1, 5).Value

        OutputQuery queryName, sourceFolder, sourceFileName, targetSheetName, targetCellAddr

    Next sourceListRow


End Sub

Private Sub OutputQuery(ByVal queryName As String, ByVal sourceFolder As String, _
                        ByVal sourceFileName As String, ByVal targetSheetName As String, ByVal targetCellAddr As String)

    Dim targetSheet As Worksheet
    Dim sourceQueryFormula As String

    sourceQueryFormula = "let" & Chr(13) & "" & Chr(10) & "    " & _
                         "Source = Table.FromColumns({Lines.FromBinary(" & _
                         "File.Contents(" & Chr(34) & sourceFolder & "\" & sourceFileName & Chr(34) & ")" & _
                         ", null, null, 1252)})," & Chr(13) & "" & Chr(10) & "    #""Split Column by Delimiter"" = Table.SplitColumn(Source, ""Column1"", Splitter.SplitTextByDelimiter("" "", QuoteStyle.Csv), {""Column1.1"", ""C" & _
                         "olumn1.2"", ""Column1.3""})," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(#""Split Column by Delimiter"",{{""Column1.1"", type number}, {""Column1.2"", type number}, {""Column1.3"", type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""

    ' Delete previous query if exists
    On Error Resume Next
    ThisWorkbook.Queries(queryName).Delete
    On Error GoTo 0

    ' Change to use thisworkbook instead of active workbook
    ThisWorkbook.Queries.Add Name:=queryName, Formula:=sourceQueryFormula

    ' Add new worksheet and change it's name
    If Not WorksheetExists(targetSheetName) Then
        Set targetSheet = ThisWorkbook.Worksheets.Add
        targetSheet.Name = targetSheetName
    Else
        Set targetSheet = ThisWorkbook.Worksheets(targetSheetName)
    End If

    With targetSheet.ListObjects.Add(SourceType:=0, source:= _
                                     "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & queryName & ";Extended Properties=""""" _
                                     , destination:=targetSheet.Range(targetCellAddr)).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & queryName & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = queryName
        .Refresh BackgroundQuery:=False
    End With

    ' Next line don't need Application.Run if your calling the macro in the same book
    'Application.Run "getUnits"
    getUnits

End Sub

Private Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
' Credits: https://stackoverflow.com/a/6688482/1521579
    Dim sht As Worksheet

    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    Set sht = wb.Sheets(shtName)
    On Error GoTo 0
    WorksheetExists = Not sht Is Nothing
End Function

---

让我知道它是否有效

最终结果是否启用了额外的“'s”？请将文件夹名称作为字符串显示给我们，好吗？可能一个小的“调整”会有所帮助。这听起来像是正确的方法。。。