如何基于目录中的文件创建包含内容的文件

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