将TDM文件批量转换为XLS [英] Batch Convert TDM files to XLS

问题描述

我的目标:通过修改一次只能使用一个文件的宏，使用现有的加载项将文件夹中的所有.TDM文件批量转换为.XLS.(也可以使用任何VBA方法.)

MY GOAL: Batch convert all .TDM files in a folder to .XLS using an existing add-in by adapting this macro that only works 1 file at a time. (Also open to any VBA approach.)

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

Using an existing add-in, a single .TDM file is converted into a single .XLS workbook with multiple sheets.

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

I need to, instead of using a prompt to select a single .TDM file, automatically convert all .TDM files in a folder into new .XLS workbooks.

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

This is part of a multi-stage process. I tried various loops, mimicking other set-ups, and merging it with other code I found on various community boards.

仅供参考:.TDM文件保存测试设备产生的工程数据输出.

FYI: .TDM files hold engineering data output produced by testing equipment.

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

推荐答案

下面是我写的一个Excel宏(VBA脚本)，用于执行与您要执行的操作非常相似的操作.它将.tdms文件的目录转换为等效的.csv文件.它需要我在 http:上获得的ExcelTDM加载项(NITDMEXCEL_2015-0-0.exe).//www.ni.com/example/27944/zh/.我在运行于适度Windows 7 Pro计算机上的Excel 2013中测试了该脚本，该计算机转换了24个TDMS文件，每个文件包含120,000行.它在大约2分钟30秒内无错误地完成了转换，每个文件大约7秒.请原谅我草率的错误处理和不良的VBA表格.

Below is an Excel Macro (VBA Script) I wrote to do something very similar to what you want to do. It converts a directory of .tdms files to their equivalent .csv files. It requires the ExcelTDM Add In (NITDMEXCEL_2015-0-0.exe) which I obtained at http://www.ni.com/example/27944/en/. I tested the script in Excel 2013 running on a modest Windows 7 Pro machine converting 24 TDMS files with 120,000 rows each file. It completed the conversions without error in about 2 minutes 30 seconds which is about 7 seconds per file. Please forgive my hasty error handling and poor VBA form.

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

这篇关于将TDM文件批量转换为XLS的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！