PDA

View Full Version : Solved: displaying certain line of text from notepad



blackguard4
07-17-2012, 12:12 PM
hi, im new to VBA
im trying to make a list of subfolders and list it on excel
- list all subfolders in excel
-- inside each subfolder there is a file that is not .txt but can be opened with notepad, the file has the same name on all the folders
-- need to extract the 41th-60th character from the notepad and display it next to its corresponding folder in excel , starting from E3, disregard line 1-40 and anything after 60

Sub ListFoldersAndInfo()

Dim FSO As Object
Dim Folder As Object
Dim FolderName As String
Dim R As Long
Dim Rng As Range
Dim SubFolder As Object
Dim Wks As Worksheet

FolderName = "E:\TestResults"

Set Wks = Worksheets("Sheet2")
Set Rng = Wks.Range("A2")
Wks.UsedRange.Offset(1, 0).ClearContents

Set FSO = CreateObject("Scripting.FileSystemObject")

Set Folder = FSO.GetFolder(FolderName)
R = 1
Rng.Cells(R, 1) = Folder.Name
Rng.Cells(R, 2) = Folder.Path
Rng.Cells(R, 3) = Folder.Size

For Each Folder In Folder.SubFolders
R = R + 1
Rng.Cells(R, 1) = Folder.Name
Rng.Cells(R, 2) = Folder.Path
Rng.Cells(R, 3) = Folder.Size
Next Folder

Set FSO = Nothing

End Sub
the help is much appreciated,
thankyou

blackguard4
07-17-2012, 12:13 PM
it seems i double post, can some1 please delete the other one, thankyou

Kenneth Hobs
07-17-2012, 12:38 PM
Sub ListFoldersAndInfo()

Dim FSO As Object
Dim Folder As Object
Dim FolderName As String
Dim R As Long
Dim Rng As Range
Dim SubFolder As Object
Dim Wks As Worksheet
Dim s As String, fn As String

FolderName = "E:\TestResults"

Set Wks = Worksheets("Sheet2")
Set Rng = Wks.Range("A2")
Wks.UsedRange.Offset(1, 0).ClearContents

Set FSO = CreateObject("Scripting.FileSystemObject")

Set Folder = FSO.GetFolder(FolderName)
R = 1
Rng.Cells(R, 1) = Folder.Name
Rng.Cells(R, 2) = Folder.Path
Rng.Cells(R, 3) = Folder.Size
fn = Folder.Path & "\ken.bin"
s = TXTStr(fn)
If Len(s) >= 61 Then Rng.Cells(R, 4) = Mid(s, 41, 19)

For Each Folder In Folder.SubFolders
R = R + 1
Rng.Cells(R, 1) = Folder.Name
Rng.Cells(R, 2) = Folder.Path
Rng.Cells(R, 3) = Folder.Size
fn = Folder.Path & "\ken.bin"
s = TXTStr(fn)
If Len(s) >= 61 Then Rng.Cells(R, 4) = Mid(s, 41, 19)
Next Folder

Set FSO = Nothing

End Sub

Function TXTStr(filePath As String) As String
Dim str As String, hFile As Integer

If Dir(filePath) = "" Then
TXTStr = "NA"
Exit Function
End If

hFile = FreeFile
Open filePath For Binary Access Read As #hFile
str = Input(LOF(hFile), hFile)
Close hFile

TXTStr = str
End Function

blackguard4
07-17-2012, 12:49 PM
thank you for the help, it works perfectly