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

我有一个现有的xls文件，根据目录中的文件创build一个CONTENTS文件。 例如，如果目录包含file.pdf和file.txt，它将创build一个包含内容的文件

file.pdf file.txt 

每个文件用换行符分隔。

我想要做的是我想要的内容包含

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

file.pdf和bundle:ORIGINAL由tab符分隔。 该目录将包含这2个文件types，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：

 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