Listing 2: The XLFormula1 Subroutine

Sub XLFormula1
posit=instr(sourcecode,"Sub XLFormula1")
endposit = instr(sourcecode,"Sub XLMisc")
textareabox1.innerText = mid(sourcecode,posit,endposit-posit)
Set XL = CreateObject("Excel.Application")
XL.Workbooks.Add
XL.Sheets.Add.name = "ComplexFormula"
XL.ActiveWorkbook.Sheets("ComplexFormula").Tab.ColorIndex = 9
XL.Visible = TRUE
row = 2 : Lastrow = Row : Col = 3 : Offset = Col - 1
XL.Cells(1, 1).Value = "FileName"
XL.Cells(1, 2).Value = "Folder"
XL.Cells(1, 3).Value = "FullPath"
XL.Cells(2, 3).Value = "c:\Folder1\SubFolder1\SubFolder2\File1.txt"
XL.Cells(3, 3).Value = "c:\Folder1\SubFolder1\SubFolder2\SubFolder3\File2.txt"
XL.Cells(4, 3).Value = "c:\Folder1\SubFolder1\SubFolder2\SubFolder3\SubFolder4\File3.txt"
lastrow = 4

'Filename
XL.Range("A2").Select
XL.ActiveCell.FormulaR1C1 = _
 "=MID(C[2],FIND(CHAR(127),SUBSTITUTE(C[2],""\"",CHAR(127),LEN(C[2])-
LEN(SUBSTITUTE(C[2],""\"",""""))))+1,254)"
'*** Note: I used 254 as a hardcoded length.  No filename should ever reach this length.  
However….
'*** You could get the length programatically with the following:
'*** "=MID(C[2],FIND(CHAR(127),SUBSTITUTE(C[2],""\"",CHAR(127),LEN(C[2])-
LEN(SUBSTITUTE(C[2],""\"",""""))))+1,LEN(C[2])-
(FIND(CHAR(127),SUBSTITUTE(C[2],""\"",CHAR(127),LEN(C[2])-
LEN(SUBSTITUTE(C[2],""\"",""""))))))"

XL.Range("A2").Select
XL.Selection.AutoFill XL.Range("A2" & ":" & "A" & lastrow)

'Folder
XL.Range("B2").Select
XL.ActiveCell.FormulaR1C1 = _
 "=LEFT(C[1],FIND(CHAR(127),SUBSTITUTE(C[1],""\"",CHAR(127),LEN(C[1])-
LEN(SUBSTITUTE(C[1],""\"",""""))))-1)"
XL.Range("B2").Select
XL.Selection.AutoFill XL.Range("B2" & ":" & "B" & lastrow)

XL.Cells.EntireColumn.AutoFit
XL.Range("A2").Select
End Sub








1