如何基於目錄中的文件創建包含內容的文件

Question

我有一個現有的xls文件，它根據目錄中的文件創建CONTENTS文件。例如，如果一個目錄包含file.pdf和file.txt，它將創建一個文件，其內容爲

file.pdf 
file.txt 

每個文件都用換行符分隔。

我想要做的就是我想要的內容包含

file.pdf bundle:ORIGINAL 
file.txt bundle:TEXT 

file.pdf和bundle:ORIGINAL由tab字符分隔。該目錄將包含這2個文件類型，1個pdf和1個文本文件。所以基本上，我想要的是，對於每個pdf文件，它應該跟着bundle:ORIGINAL文本，而如果它是一個文本文件，則應該跟着bundle:TEXT。

原來的代碼如下：

For i = 2 To lRows 
If Trim(Cells(i, 1).Value) = "" Then Exit For 

' create the CONTENTS file 

FileList = GetFileList(oDirectory & "\" & Trim(Cells(i, lCols).Value) & "\") 
cFileNum = FreeFile 
ContentsPath = oDirectory & "\" & Trim(Cells(i, lCols).Value) & "\" & "contents" 
Open ContentsPath For Output As #cFileNum 
For k = 1 To UBound(FileList) 
If (FileList(k) <> "contents" And FileList(k) <> "dublin_core.xml") Then 
    Print #cFileNum, FileList(k) 
    End If 
    Next k 
Close #cFileNum 

編輯

這是功能GetFileList

Function GetFileList(FileSpec As String) As Variant 
' Returns an array of filenames that match FileSpec 
' If no matching files are found, it returns False 

Dim FileArray() As Variant 
Dim FileCount As Integer 
Dim FileName As String 

On Error GoTo NoFilesFound 

FileCount = 0 
FileName = Dir(FileSpec) 
If FileName = "" Then GoTo NoFilesFound 

' Loop until no more matching files are found 
Do While FileName <> "" 
    FileCount = FileCount + 1 
    ReDim Preserve FileArray(1 To FileCount) 
    FileArray(FileCount) = FileName 
    FileName = Dir() 
Loop 
GetFileList = FileArray 
Exit Function 

' Error handler 
NoFilesFound: 
GetFileList = False 
End Function 

請注意，我明明不是這個代碼的作者，我剛剛下載這個excel文件（該網站不再存在）很久以前，我只需要調整這個爲我自己使用。

在此先感謝。

Answer 1

像這樣的東西應該這樣做：

'... 
If (FileList(k) <> "contents" And FileList(k) <> "dublin_core.xml") Then 
    Print #cFileNum, FileList(k) & vbTab & GetType(Cstr(FileList(k))) 
End If 
'... 

功能：

Function GetType(fName as string) 
    Dim rv As String 
    Select Case Right(Ucase(fName),3) 
     Case "TXT": rv = "bundle:TEXT" 
     Case "PDF": rv = "bundle:ORIGINAL" 
    End Select 
    GetType = rv 
End Function