→ Catbert:話說..EZsoft版精華區就有你要的程式嚕:P 16.10~14 12/14 01:49
※ 引述《aisassu (Aisassu)》之銘言：
: 恩~首先感謝各位大大進來觀看小弟的問題
: 問題如下
: 我在 資料夾A 有很多個中文或日文的檔案
: 此時我想以VB寫一個程式去讀取資料夾A中的檔案名稱(可以的話希望包含副檔名)
: 大多為PDF檔案，PPT，以及WORD檔案
: 並將讀取的資料寫入EXCEL的檔案中
: 以A1 A2 A3 等位置格式填入
: 若情況允許
: 希望填入的方式為
: A_檔案名稱
: A是指資料夾名稱
: 檔案名稱則是所讀取的檔案名稱
: 希望有大大可以指導或者手頭上有類似的CODE可以給我參考
: 或者加入我的MSN一起討論一下
: jero034@msn.com
: 因為小弟是新手
: 可能會有一些很基礎的問題
: 在此感謝指教
這是我之前寫過把同資料夾下的多個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