Using kedaman's idea:
Code:Option Base 1 Private Sub SendToExcel(Files) Dim x As Excel.Application Dim objSheet As Excel.Worksheet Set x = CreateObject("Excel.Application") ' create object Set objSheet = x.Workbooks.Open(App.Path & "\MyXls.xls").ActiveSheet 'open the workbook For i = 1 To UBound(Files) objSheet.Cells(i, 1).Value = Files(i) 'write to excel Next objSheet.Columns(1).AutoFit 'fit the column x.Visible = True 'show excel Set objSheet = Nothing 'free memory Set x = Nothing End Sub Private Function GetFileNames(Folder As String) Dim Vals() Dim TotalFiles As Integer Dim CurrentFile As String Dim i CurrentFile = Dir(Folder) 'get first file Do While CurrentFile <> "" 'loop until end i = i + 1 ReDim Preserve Vals(i) 'resize array Vals(i) = CurrentFile 'set value CurrentFile = Dir 'get new value Loop GetFileNames = Vals End Function '------------------------------------------------------------------------------- 'Usage: Dim Files() Files = GetFileNames("C:\") SendToExcel (Files)




Reply With Quote