- @Echo Off
- SetLocal EnableDelayedExpansion
- (For /F "Delims=_ Tokens=1,4,5" %%a In ('Dir /B *.jpg') Do (
- Set C1=%%a
- Set C2=%%b
- Set C3=%%c
- Echo !C1:~10,9! !C2:~0,9! !C3:~0,9!
- ))>list.txt
- start TXT2EXCEL.vbs
复制代码 不会用vbs,只好这样了- Call Txt2Excel
-
- Sub Txt2Excel
- Const FsoForReading = 1 ' 打开一个只读文件,不能对此文件进行写操作。
- Const FsoForWriting = 2 ' 打开一个用于写操作的文件。如果和此文件同名的文件已存在,则覆盖以前内容。
- Const FsoForAppending = 8 ' 打开一个文件并写到文件的尾部。
-
- ' 文本文件名,Excel文件名
- Dim vTxtFileName, vExcelFileName
- vTxtFileName = "list.txt" ' TXT File
- vExcelFileName = "G:\list.xls" ' Excel File
-
- ' 文本文件对象,检查
- Dim fsoTxt, oTxtFile
- Set fsoTxt=CreateObject("scripting.FileSystemObject")
- If fsoTxt.FileExists( vTxtFileName ) Then
- Set oTxtFile = fsoTxt.openTextFile( vTxtFileName, FsoForReading, False )
- Else
- MsgBox "文件不存在,请检查!"
- Exit Sub
- End If
-
- ' Excel文件对象,检查
- Dim fsoExcel, oExcelFile
- Set fsoExcel = CreateObject("scripting.FileSystemObject")
- Set oExcelFile = CreateObject("Excel.Application")
- If oExcelFile Is Nothing Then MsgBox "系统未检测到安装了EXCEL!"
- oExcelFile.DisplayAlerts = False
- ' oExcelFile.Visible = True 'Debug
-
- If Not fsoExcel.FileExists(vExcelFileName) Then
- oExcelFile.Workbooks.Add
- oExcelFile.Sheets.Item(1).Select
- End If
-
- ' 读取文本,截取单元值,写入Excel表格
- Dim vText, vUnit1, vUnit2, vUnit3, vUnit4, vUnit5, vUnit6, vUnit7, vUnit8, vUnit9, vUnit10
- Dim vRow
- vRow = 1
- While Not oTxtFile.AtEndOfLine
- vText = oTxtFile.ReadLine
- vUnit1 = Left(vText, 10)
- vUnit2 = Mid(vText,11,9)
- vUnit3 = Mid(vText,21,9)
- With oExcelFile.Sheets.Item(1)
- .Range("A" & vRow).Value = vUnit1
- .Range("B" & vRow).Value = vUnit2
- .Range("C" & vRow).Value = vUnit3
- End With
- vRow = vRow + 1
- Wend
-
- ' 打扫战场
- oTxtFile.Close
- Set oTxtFile = Nothing
- Set fsoTxt = Nothing
-
- oExcelFile.ActiveWorkbook.SaveAs vExcelFileName
- oExcelFile.Quit
- Set oExcelFile = Nothing
- Set fsoExcel = Nothing
- End Sub
复制代码 保存为TXT2EXCEL.vbs |