Question

我的目标：通过调整此宏，一次只能处理1个文件，使用现有的加载项将文件夹中的所有.TDM文件批量转换为.XLS。（也适用于任何VBA方法。）

使用现有的加载项，单个.TDM文件将转换为具有多个工作表的单个.XLS工作簿。

我需要，而不是使用提示选择单个.TDM文件，而是自动将文件夹中的所有.TDM文件转换为新的.XLS工作簿。

这是多阶段过程的一部分。我尝试了各种循环，模仿其他设置，并将其与我在各种社区主板上找到的其他代码合并。

仅供参考：.TDM文件包含测试设备产生的工程数据输出。

Sub GetTDM_AddIn()

'Get TDM Excel Add-In
 Dim obj As COMAddIn
 Set obj = Application.COMAddIns.Item("ExcelTDM.TDMAddin")
 'obj.Connect = True

 'Confirm only importing "Description" properties for Root
 Call obj.Object.Config.RootProperties.DeselectAll
 Call obj.Object.Config.RootProperties.Select("Description")

 'Show the group count as property
 Call obj.Object.Config.RootProperties.Select("Groups")

 'Select all the available properties for Group
 Call obj.Object.Config.GroupProperties.SelectAll

 'Import custom properties
 obj.Object.Config.RootProperties.SelectCustomProperties = True
 obj.Object.Config.GroupProperties.SelectCustomProperties = True
 obj.Object.Config.ChannelProperties.SelectCustomProperties = True

 'Let the user choose which file to import
 Dim fileName
 fileName = Application.GetOpenFilename("TDM & TDMS (*.tdm;*.tdms),*.tdm;*.tdms")
 If fileName = False Then
 ' User selected Cancel
 Exit Sub
 End If

 'Import the selected file
 Call obj.Object.ImportFile(fileName)

 'Record down the current workbook
 Dim Workbook As Object
 Set Workbook = ActiveWorkbook

 End Sub

Answer 1

下面是我编写的Excel宏（VBA脚本），用于执行与您想要执行的操作非常相似的操作。它将.tdms文件的目录转换为其等效的.csv文件。它需要我在http://www.ni.com/example/27944/en/获得的ExcelTDM添加（NITDMEXCEL_2015-0-0.exe）。我测试了运行在适度的Windows 7 Pro机器上的Excel 2013中的脚本，转换了24个TDMS文件，每个文件有120,000行。它在大约2分30秒内完成了无错误的转换，每个文件大约7秒。请原谅我草率的错误处理和糟糕的VBA表格。

Sub ConvertTDMStoCSV()
'
' ConvertTDMS Macro
'
' Acts upon all .tdms files in a "source" directory,
' loading each one using the ExcelTDM Add In,
' deleting the first sheet and saving the
' remaining stream data as one .csv file
' in a "target" directory.  Writes a list of
' the files converted in a new sheet.
'
' Tested to work with Excel 2013 on Windows 7
' with NITDMEXCEL_2015-0-0.exe obtained at
' http://www.ni.com/example/27944/en/

    Dim sourceDir As String, targetDir As String, fn As String, fnBase As String
    Dim fso As Object, n As Long, resp As Integer, strNow As String, newSheet As Object
    Dim tdmsAddIn As COMAddIn, importedWorkbook As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Set tdmsAddIn = Application.COMAddIns.Item("ExcelTDM.TDMAddin")
    tdmsAddIn.Connect = True
    Call tdmsAddIn.Object.Config.RootProperties.DeselectAll
    Call tdmsAddIn.Object.Config.ChannelProperties.DeselectAll
    tdmsAddIn.Object.Config.RootProperties.SelectCustomProperties = False
    tdmsAddIn.Object.Config.GroupProperties.SelectCustomProperties = False
    tdmsAddIn.Object.Config.ChannelProperties.SelectCustomProperties = False


    'Choose TDMS Source Directory
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choose Source Directory of TDMS Files"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path & "\"
        .Show
        On Error Resume Next
        sourceDir = .SelectedItems(1)
        Err.Clear
        On Error GoTo 0
    End With
    If Dir(sourceDir, vbDirectory) = "" Then
        MsgBox "No such folder.", vbCritical, sourceDir
        Exit Sub
    End If

    'Choose CSV Target Directory
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choose Target Directory for CSV Files"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path & "\"
        .Show
        On Error Resume Next
        targetDir = .SelectedItems(1)
        Err.Clear
        On Error GoTo 0
    End With
    If Dir(targetDir, vbDirectory) = "" Then
        MsgBox "No such folder.", vbCritical, targetDir
        Exit Sub
    End If



    fn = Dir(sourceDir & "\*.tdms")
    If fn = "" Then
        MsgBox "No source TDMS files found.", vbInformation
        Exit Sub
    End If

    resp = MsgBox("Begin conversion of TDMS files?" & vbCrLf & sourceDir & vbCrLf & "to" & vbCrLf & targetDir, vbYesNo, "Confirmation")
    If resp = vbNo Then
        MsgBox "Execution cancelled by user."
        Exit Sub
    End If

    Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    strNow = WorksheetFunction.Text(Now(), "m-d-yyyy h_mm_ss")
    newSheet.Name = strNow
    newSheet.Cells(1, 1).Value = "Files converted on " & strNow
    newSheet.Cells(2, 1).Value = "TDMS Source Directory: " & sourceDir
    newSheet.Cells(3, 1).Value = "CSV Target Directory: " & targetDir


    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    n = 5
    Do While fn <> ""
        fnBase = fso.GetBaseName(fn)

        On Error Resume Next
        Call tdmsAddIn.Object.ImportFile(sourceDir & "\" & fn, True)
        If Err Then
            MsgBox Err.Description, vbCritical
            Exit Sub
        End If
        Set importedWorkbook = ActiveWorkbook
        Application.DisplayAlerts = False
        importedWorkbook.Sheets(1).Delete
        importedWorkbook.SaveAs Filename:=targetDir & "\" & fnBase & ".csv", FileFormat:=xlCSV
        importedWorkbook.Close savechanges:=False
        Application.DisplayAlerts = True

        newSheet.Cells(n, 1).Value = fnBase
        n = n + 1
        fn = Dir
    Loop
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True


    Set fso = Nothing
    Set newSheet = Nothing
    Set importedWorkbook = Nothing
End Sub

Answer 2

我建议您使用powershell获取所有文件，然后使用Run方法为每个文件调用Excel宏，而不是尝试在VBA中执行此操作。

您还需要将宏修改为（1）在当前打开的文件上运行（下面的解决方案）;或（2）将文件名作为参数（这会将调用更改为下面的Run）

代码是这样的（修改对get-childitem的调用以适合您的应用程序）：

$excel = new-object -comobject excel.application
$files = get-childitem ... #etc, collect your files into an array
foreach ($file in $files)
{
    $wb = $excel.workbooks.open($file.fullname)
    $ws= $wb.worksheets.item(1)
    $ws.Activate()
    $excel.Run("GetTDM_AddIn")
    $wb.save()
    $wb.close()
}
$excel.quit()

Answer 3

我使用了这个简单的应用程序来转换tdms文件。它支持多个文件并具有命令行支持。 http://www.whiterocksoftware.com/2019/11/batch-convert-tdms-to-excel.html

批量转换TDM文件到XLS

3 个答案: