[文件操作] [已解决]批处理如何提取文件名并将之输出到EXCEL中生成三列？

haichuan5121

有文件夹下有很多这个格式命名的图片，求大神批处理提取文件名，并将之输出到EXCEL中 生成三列。格式大概如下分别是
结果：
aal  ，    -600.652 ，-63.372；
cal ，    -80.605，  -263.32；
文件名：
1abc123352aal_1440_0585_-600.625_-63.372_pad.jpg
1abD123352cal_1440_0585_-80.605_-263.32_pad.jpg

34205

很强大，学习了.........

bailong360

回复 3# haichuan5121


    忘记说了,代码执行完毕后会在G盘生成一个xls,里面才是真正的结果
没有考虑到一般人的G盘是移动磁盘...

apang

@echo off
setlocal enabledelayedexpansion
(for /f "tokens=1,4,5delims=_" %%a in ('dir /b *.jpg') do (
        set "a=%%a"
        echo,!a:~-3!,%%b,%%c
))>1.csv
pause
复制代码

haichuan5121

回复 2# bailong360


    还有就是大侠生成的是TXT文本，导入EXCEL不是分列的 是一列里面三段，不过应急够了，可以下班了，继续求大神！

haichuan5121

回复 2# bailong360


    太感谢了，结果可以实现，就是分成两部分有点繁琐，能不能合成一个啊，

bailong360

@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