※ 引述《aisassu (Aisassu)》之铭言： : 恩~首先感谢各位大大进来观看小弟的问题 : 问题如下 : 我在 资料夹A 有很多个中文或日文的档案 : 此时我想以VB写一个程式去读取资料夹A中的档案名称(可以的话希望包含副档名) : 大多为PDF档案，PPT，以及WORD档案 : 并将读取的资料写入EXCEL的档案中 : 以A1 A2 A3 等位置格式填入 : 若情况允许 : 希望填入的方式为 : A_档案名称 : A是指资料夹名称 : 档案名称则是所读取的档案名称 : 希望有大大可以指导或者手头上有类似的CODE可以给我参考 : 或者加入我的MSN一起讨论一下 : [email protected] : 因为小弟是新手 : 可能会有一些很基础的问题 : 在此感谢指教 这是我之前写过把同资料夹下的多个CSV档合并成一个Excel的程式， 你可以试着改改看XD ======== Dim objShell 'Declare SHELL Dim objFSO 'Declare FileSystemObject Dim objXLApp 'Declare Excel Application Dim newFileName 'Declare Destination File Name Dim newWB 'Declare Destination Workbook Dim FileLists 'Declare Files in Script Directory Dim objFile 'Declare File Object Dim objXLBook 'Declare Workbook Set objShell = WScript.CreateObject("WScript.Shell") Set objFSO = CreateObject("Scripting.FileSystemObject") Set objXLApp = WScript.CreateObject("Excel.Application") objXLApp.Visible = True newfilename = InputBox("请输入档案名称：") newfilename = objShell.CurrentDirectory &"\"& newfilename If (Right(newfilename, 3) <> "xls") Then newfilename = newfilename & ".xls" End If set newWB = objXLApp.Workbooks.add newWB.SaveAs newfilename Set FileLists = objFSO.GetFolder(objShell.CurrentDirectory).Files For Each objFile in FileLists '判断现在抓到的档案副档名 If(objFSO.GetExtensionName(objFile) ="csv" and &_ objfile.name <> newWB.name) Then '从这边改写吧XD Set objXLBook = objXLApp.Workbooks.Open(objFSO.GetAbsolutePathName(objFile)) objXLBook.Worksheets.Copy , newWB.Worksheets(newWB.Worksheets.Count) objXLBook.Close End If Next '删除掉新Excel档的前3张Sheet '以你的需求可以把这行删掉 newWB.Worksheets(Array(1, 2, 3)).Delete newWB.Save '存档 newWB.Close '关档 objXLAPP.Quit '关闭Excel WScript.Quit '关闭WScript '下面都是在释放物件 Set objXLBook = Nothing set objFile = Nothing set FileLists = Nothing Set newWB = Nothing set newfilename = Nothing Set objXLApp = Nothing Set objFSO = Nothing Set objShell = Nothing ======= 上面的程式可以自己改改看.... 应该不太难:P -- 没事多灌水... 多灌水没事... --

※ 发信站: 批踢踢实业坊(ptt.cc) ◆ From: 221.169.7.130