批量使用加载项将TDM文件转换为XLS，一次只能运行1个
第一次海报 。 我的目标：使用现有的加载项，将文件夹中的所有.TDM文件批量转换为.XLS，方法是适应一次只能处理一个文件的macros。 （也可以打开任何VBA方法）
使用现有的加载项，单个.TDM文件将转换为具有多个工作表的单个.XLS工作簿。 我需要这个macros重复它已经做的相同的过程，而不是使用提示select一个.TDM文件，我需要它来自动select和转换文件夹中的所有.TDM文件到新的.XLS工作簿。
这是多阶段过程的一部分，即使尝试了各种循环，模仿其他设置，并将其与我在各种社区主板上find的其他代码合并后，我也无法工作。
我有中级的VBA经验..我相信我已经接近解决它..所以很可能任何专业人士可以快速/容易地解决这个问题。
FYI：.TDM文件保存testing设备产生的工程数据输出。
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 提前致谢。
下面是我写的一个Excelmacros（VBA脚本），用于执行与您想要执行的操作非常相似的操作。 它将.tdms文件的目录转换为其等效的.csv文件。 它需要我在http://www.ni.com/example/27944/en/获得的ExcelTDM Add In（NITDMEXCEL_2015-0-0.exe）。 我testing了Excel 2013中的脚本，在一台适中的Windows 7 Pro机器上运行，每台文件以120,000行转换24个TDMS文件。 它在大约2分30秒内完成了无误的转换，每个文件大约7秒。 请原谅我仓促的error handling和糟糕的VBAforms。
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(), "md-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
我不build议在VBA中这样做，而是build议您使用powershell来获取所有文件，然后使用Run方法为每个文件调用Excelmacros。
您还需要修改macros以（1）在当前打开的文件上运行（下面的解决scheme）; 或者（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()